From 0f9c175fc11e963b52fd4b9a55f8145fc58f512d Mon Sep 17 00:00:00 2001 From: shah Date: Tue, 27 Oct 2026 00:18:19 -0500 Subject: [PATCH 01/19] Add TLS ClientHello parser and printer, with proved round trip --- .gitignore | 3 + ClientHello.lean | 2 + ClientHello/Parse.lean | 270 ++++++ ClientHello/Value.lean | 224 +++++ Main.lean | 87 ++ Proofs.lean | 2 + Proofs/RoundTrip.lean | 2036 ++++++++++++++++++++++++++++++++++++++++ Proofs/Verify.lean | 4 + README.md | 119 ++- SPEC.md | 166 ++++ lake-manifest.json | 6 + lakefile.toml | 13 + lean-toolchain | 1 + tests/TEST-RESULTS.md | 59 ++ tests/run_tests.py | 860 +++++++++++++++++ 15 files changed, 3829 insertions(+), 23 deletions(-) create mode 100644 ClientHello.lean create mode 100644 ClientHello/Parse.lean create mode 100644 ClientHello/Value.lean create mode 100644 Main.lean create mode 100644 Proofs.lean create mode 100644 Proofs/RoundTrip.lean create mode 100644 Proofs/Verify.lean create mode 100644 SPEC.md create mode 100644 lake-manifest.json create mode 100644 lakefile.toml create mode 100644 lean-toolchain create mode 100644 tests/TEST-RESULTS.md create mode 100644 tests/run_tests.py diff --git a/.gitignore b/.gitignore index 01f8cdb..a2759c4 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,4 @@ .lake/ +__pycache__/ +venv/ +scratch/ diff --git a/ClientHello.lean b/ClientHello.lean new file mode 100644 index 0000000..cd42942 --- /dev/null +++ b/ClientHello.lean @@ -0,0 +1,2 @@ +import ClientHello.Value +import ClientHello.Parse diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean new file mode 100644 index 0000000..275fe5b --- /dev/null +++ b/ClientHello/Parse.lean @@ -0,0 +1,270 @@ +/- + The TLS ClientHello parser. It reads one record holding + one ClientHello and returns the message, or `none` when the + bytes break any of the rules in SPEC.md. Every read is + length checked before it happens, so the parser never + reads past the end of its input: + + - The record header is five bytes: content type 22, a + legacy record version carried unchecked, and a two byte + length. The body is exactly that many bytes, and no bytes + may follow the record. A body of length 0 cannot hold a + handshake header, so it is turned away by the body read. + - The handshake header is a type byte, which must be 1, + and a three byte length that must cover the rest of the + record body exactly. + - The body fields follow their length rules: session id at + most 32 bytes; cipher suites an even byte count of at + least 2; compression methods at least one byte and the + null method 0 among them. A body that ends before the + extensions length is turned away: the extensions block + must be present, though it may be empty. + - The extensions block is consumed exactly. Each extension + is a type, a length, and that many value bytes; a length + running past the block turns the message away, and a + type standing twice turns it away. + - Four extension values are decoded. In each, the inner + length must cover the rest of the value exactly. Server + name entries may not repeat a name type, and a host_name + entry must be nonempty. ALPN names must be nonempty. + supported_versions in a hello is a list of two byte + versions of even, nonzero byte length. Key share entries + may not repeat a group, and key exchange bytes must be + nonempty. Every other type is carried opaque. + + The variable length lists are read with a fuel count, one + more than the length of the input at the top level, which + is always enough, since every step takes bytes. A hostile + input is rejected, never looped on. +-/ + +import ClientHello.Value + +namespace ClientHello + +/-- Read one byte as a value, with the rest of the input. -/ +def getU8 : List UInt8 → Option (Nat × List UInt8) + | b :: rest => some (b.toNat, rest) + | [] => none + +/-- Read two bytes as a big endian value, with the rest of + the input. Fewer than two bytes gives `none`. -/ +def getU16 : List UInt8 → Option (Nat × List UInt8) + | a :: b :: rest => some (u16 a b, rest) + | _ => none + +/-- Read three bytes as a big endian value, with the rest of + the input. Fewer than three bytes gives `none`. -/ +def getU24 : List UInt8 → Option (Nat × List UInt8) + | a :: b :: c :: rest => some (u24 a b c, rest) + | _ => none + +/-- Read `n` bytes as a block, with the rest of the input. + Fewer than `n` bytes gives `none`. -/ +def getBytes (n : Nat) (bs : List UInt8) : + Option (List UInt8 × List UInt8) := + if (bs.take n).length = n then some (bs.take n, bs.drop n) + else none + +/-- Read a list of two byte values from bytes that must be + consumed exactly. An odd trailing byte gives `none`. -/ +def parsePairs : List UInt8 → Option (List Nat) + | [] => some [] + | a :: b :: rest => + (parsePairs rest).map (fun vs => u16 a b :: vs) + | _ => none + +/-- Read server name entries with a fuel count. A name type + standing twice in the list gives `none`; the repeat + check is made against the entries that follow. -/ +def parseNameEntriesGo : + Nat → List UInt8 → Option (List (Nat × List UInt8)) + | 0, _ => none + | _ + 1, [] => some [] + | f + 1, t :: rest => + getU16 rest >>= fun (n, r1) => + if (r1.take n).length = n then + parseNameEntriesGo f (r1.drop n) >>= fun es => + if t.toNat ∈ es.map Prod.fst then none + else some ((t.toNat, r1.take n) :: es) + else none + +/-- Read server name entries, with enough fuel for the whole + input. -/ +def parseNameEntries (bs : List UInt8) : + Option (List (Nat × List UInt8)) := + parseNameEntriesGo (bs.length + 1) bs + +/-- The server name value check that stands outside the + entry grammar: the list is nonempty, and every host_name + entry (type 0) carries at least one byte. -/ +def validNames (es : List (Nat × List UInt8)) : Bool := + !es.isEmpty && + es.all (fun e => decide (e.1 ≠ 0 ∨ e.2 ≠ [])) + +/-- Read the server_name value: a two byte list length that + covers the rest of the value, then the entries, then + the value check. -/ +def parseSNI (v : List UInt8) : Option Extension := + getU16 v >>= fun (n, rest) => + if rest.length = n then + parseNameEntries rest >>= fun es => + if validNames es then some (.serverName es) else none + else none + +/-- Read ALPN protocol names with a fuel count. An empty + name gives `none`. -/ +def parseAlpnGo : Nat → List UInt8 → Option (List (List UInt8)) + | 0, _ => none + | _ + 1, [] => some [] + | f + 1, len :: rest => + if len.toNat = 0 then none + else if (rest.take len.toNat).length = len.toNat then + (parseAlpnGo f (rest.drop len.toNat)).map + (fun ns => (rest.take len.toNat) :: ns) + else none + +/-- Read ALPN protocol names, with enough fuel for the whole + input. -/ +def parseAlpnNames (bs : List UInt8) : + Option (List (List UInt8)) := + parseAlpnGo (bs.length + 1) bs + +/-- Read the ALPN value: a two byte list length that covers + the rest of the value, then at least one name. -/ +def parseALPN (v : List UInt8) : Option Extension := + getU16 v >>= fun (n, rest) => + if rest.length = n then + parseAlpnNames rest >>= fun ns => + if ns.isEmpty then none else some (.alpn ns) + else none + +/-- Read the supported_versions value, in the ClientHello + form: a one byte length, even and at least 2, then that + many bytes as two byte versions. -/ +def parseSV (v : List UInt8) : Option Extension := + match v with + | n :: rest => + if rest.length = n.toNat ∧ n.toNat % 2 = 0 ∧ 2 ≤ n.toNat + then parsePairs rest >>= fun vs => + some (.supportedVersions vs) + else none + | [] => none + +/-- Read key share entries with a fuel count. Empty key + exchange bytes give `none`, and a group standing twice + in the list gives `none`. -/ +def parseSharesGo : + Nat → List UInt8 → Option (List (Nat × List UInt8)) + | 0, _ => none + | _ + 1, [] => some [] + | f + 1, bs => + getU16 bs >>= fun (g, r1) => + getU16 r1 >>= fun (n, r2) => + if n = 0 then none + else if (r2.take n).length = n then + parseSharesGo f (r2.drop n) >>= fun ss => + if g ∈ ss.map Prod.fst then none + else some ((g, r2.take n) :: ss) + else none + +/-- Read key share entries, with enough fuel for the whole + input. -/ +def parseShares (bs : List UInt8) : + Option (List (Nat × List UInt8)) := + parseSharesGo (bs.length + 1) bs + +/-- Read the key_share value, in the client form: a two + byte list length that covers the rest of the value, then + at least one entry. -/ +def parseKS (v : List UInt8) : Option Extension := + getU16 v >>= fun (n, rest) => + if rest.length = n then + parseShares rest >>= fun ss => + if ss.isEmpty then none else some (.keyShare ss) + else none + +/-- Read one extension value, by its type. The four decoded + types go to their readers; every other type is carried + opaque, as the type and the value bytes as they stood. -/ +def parseExtValue (t : Nat) (v : List UInt8) : + Option Extension := + if t = 0 then parseSNI v + else if t = 16 then parseALPN v + else if t = 43 then parseSV v + else if t = 51 then parseKS v + else some (.opaque t v) + +/-- Read the extensions of a block that must be consumed + exactly, with a fuel count. An extension length running + past the block gives `none`, and a type standing twice + gives `none`. -/ +def parseExtsGo : Nat → List UInt8 → Option (List Extension) + | 0, _ => none + | _ + 1, [] => some [] + | f + 1, bs => + getU16 bs >>= fun (t, r1) => + getU16 r1 >>= fun (n, r2) => + if (r2.take n).length = n then + parseExtValue t (r2.take n) >>= fun e => + parseExtsGo f (r2.drop n) >>= fun es => + if extType e ∈ es.map extType then none + else some (e :: es) + else none + +/-- Read an extensions block, with enough fuel for the + whole block. -/ +def parseExts (bs : List UInt8) : Option (List Extension) := + parseExtsGo (bs.length + 1) bs + +/-- Read the body fields from bytes that are exactly the + fields: legacy version, random, session id, cipher + suites, compression methods, and the extensions block, + which must be present and must run to the end. -/ +def parseBodyFields (bs : List UInt8) : Option Hello := + getU16 bs >>= fun (ver, r1) => + getBytes 32 r1 >>= fun (rand, r2) => + getU8 r2 >>= fun (slen, r3) => + (if slen ≤ 32 then getBytes slen r3 else none) >>= + fun (sess, r4) => + getU16 r4 >>= fun (clen, r5) => + (if clen % 2 = 0 ∧ 2 ≤ clen then getBytes clen r5 + else none) >>= fun (cbytes, r6) => + parsePairs cbytes >>= fun suites => + getU8 r6 >>= fun (mlen, r7) => + (if 1 ≤ mlen then getBytes mlen r7 else none) >>= + fun (comps, r8) => + if (0 : UInt8) ∈ comps then + getU16 r8 >>= fun (elen, r9) => + getBytes elen r9 >>= fun (ebytes, r10) => + if r10 = [] then + parseExts ebytes >>= fun exts => + some ⟨ver, rand, sess, suites, comps, exts⟩ + else none + else none + +/-- Read the handshake message from a record body: the type + byte must be 1, and the three byte length must cover the + rest of the body exactly. -/ +def parseBody (body : List UInt8) : Option Hello := + getU8 body >>= fun (htype, r1) => + if htype = 1 then + getU24 r1 >>= fun (hlen, r2) => + getBytes hlen r2 >>= fun (fbs, r3) => + if r3 = [] then parseBodyFields fbs else none + else none + +/-- Parse a whole message: one record, holding one + ClientHello, with no bytes after the record. -/ +def parse (bs : List UInt8) : Option Message := + getU8 bs >>= fun (ct, r1) => + if ct = 22 then + getU16 r1 >>= fun (rv, r2) => + getU16 r2 >>= fun (rlen, r3) => + getBytes rlen r3 >>= fun (body, r4) => + if r4 = [] then + (parseBody body).map (fun h => ⟨rv, h⟩) + else none + else none + +end ClientHello diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean new file mode 100644 index 0000000..425a582 --- /dev/null +++ b/ClientHello/Value.lean @@ -0,0 +1,224 @@ +/- + The TLS ClientHello data model and the canonical printer. + + A message is one TLS record holding one ClientHello, in the + shape of RFC 8446 section 4.1.2 with the legacy fields of + RFC 5246. The record header carries a content type, which + must be 22 (handshake), a legacy record version, which is + carried unchecked, and a length. Inside it, a handshake + header carries the message type, which must be 1 + (client_hello), and a three byte length. The body holds the + legacy version, the 32 byte random, the legacy session id, + the cipher suites, the legacy compression methods, and the + extensions. + + Four extensions are decoded: server_name (0, RFC 6066 + section 3), ALPN (16, RFC 7301), supported_versions (43), + and key_share (51). Every other extension is carried as its + type and its raw value bytes, length checked and not read. + + Numbers are held as plain natural numbers. Byte blocks are + held as byte lists. Printing recomputes every length from + the value it prints, so a printed message is the canonical + form of the value. +-/ + +namespace ClientHello + +/-- A value as two bytes, big endian. The value is taken + modulo 2^16; callers only pass values below that. -/ +def be16 (n : Nat) : List UInt8 := + [ (n / 256).toUInt8, n.toUInt8 ] + +/-- The value of two bytes read big endian. -/ +def u16 (a b : UInt8) : Nat := + a.toNat * 256 + b.toNat + +/-- A value as three bytes, big endian. The value is taken + modulo 2^24; callers only pass values below that. -/ +def be24 (n : Nat) : List UInt8 := + [ (n / 65536).toUInt8, (n / 256).toUInt8, n.toUInt8 ] + +/-- The value of three bytes read big endian. -/ +def u24 (a b c : UInt8) : Nat := + a.toNat * 65536 + b.toNat * 256 + c.toNat + +/-- One extension. The four decoded forms are distinct from + the opaque form, which carries a type the slice does not + decode and the value bytes as they stood. A server name + entry is a name type and its bytes; a key share entry is + a group and its key exchange bytes. -/ +inductive Extension where + | serverName (entries : List (Nat × List UInt8)) : Extension + | alpn (names : List (List UInt8)) : Extension + | supportedVersions (versions : List Nat) : Extension + | keyShare (shares : List (Nat × List UInt8)) : Extension + | opaque (extType : Nat) (value : List UInt8) : Extension + deriving DecidableEq, Repr + +/-- The wire type of an extension. -/ +def extType : Extension → Nat + | .serverName _ => 0 + | .alpn _ => 16 + | .supportedVersions _ => 43 + | .keyShare _ => 51 + | .opaque t _ => t + +/-- Two byte values in printed form, one after another. -/ +def printPairs : List Nat → List UInt8 + | [] => [] + | v :: vs => be16 v ++ printPairs vs + +/-- Server name entries in printed form: a name type byte, a + two byte length, and the name bytes. -/ +def printNameEntries : List (Nat × List UInt8) → List UInt8 + | [] => [] + | (t, bs) :: es => + (t.toUInt8 :: (be16 bs.length ++ bs)) ++ printNameEntries es + +/-- ALPN protocol names in printed form: a one byte length + and the name bytes. -/ +def printAlpnNames : List (List UInt8) → List UInt8 + | [] => [] + | n :: ns => (n.length.toUInt8 :: n) ++ printAlpnNames ns + +/-- Key share entries in printed form: a two byte group, a + two byte length, and the key exchange bytes. -/ +def printShares : List (Nat × List UInt8) → List UInt8 + | [] => [] + | (g, k) :: ss => + (be16 g ++ (be16 k.length ++ k)) ++ printShares ss + +/-- The value bytes of an extension, as the printer writes + them. Three of the decoded forms open with a length that + covers the rest of the value: two bytes for server_name + and key_share, one byte for supported_versions in a + ClientHello. -/ +def printExtValue : Extension → List UInt8 + | .serverName es => + be16 (printNameEntries es).length ++ printNameEntries es + | .alpn ns => + be16 (printAlpnNames ns).length ++ printAlpnNames ns + | .supportedVersions vs => + (printPairs vs).length.toUInt8 :: printPairs vs + | .keyShare ss => + be16 (printShares ss).length ++ printShares ss + | .opaque _ v => v + +/-- One extension in printed form: type, length, value. -/ +def printExt (e : Extension) : List UInt8 := + be16 (extType e) ++ be16 (printExtValue e).length ++ + printExtValue e + +/-- The extension list in printed form. -/ +def printExts : List Extension → List UInt8 + | [] => [] + | e :: es => printExt e ++ printExts es + +/-- The ClientHello body fields, in wire order. -/ +structure Hello where + /-- The legacy version, two bytes. Carried unchecked. -/ + legacyVersion : Nat + /-- The random: 32 bytes in a well formed message. -/ + random : List UInt8 + /-- The legacy session id: at most 32 bytes in a well + formed message. -/ + sessionId : List UInt8 + /-- The cipher suites, as two byte codes. A well formed + message holds at least one. -/ + cipherSuites : List Nat + /-- The legacy compression methods. A well formed message + holds at least one, and the null method 0 is among + them. -/ + compressionMethods : List UInt8 + /-- The extensions, in wire order. No type stands twice in + a well formed message. -/ + extensions : List Extension + deriving DecidableEq, Repr + +/-- One record holding one ClientHello. -/ +structure Message where + /-- The legacy record version, two bytes. Carried + unchecked. -/ + recordVersion : Nat + /-- The ClientHello the record holds. -/ + hello : Hello + deriving DecidableEq, Repr + +/-- The body fields in printed form, without the handshake + header: legacy version, random, session id with its one + byte length, cipher suites with their two byte length, + compression methods with their one byte length, and the + extensions with their two byte length. -/ +def printBodyFields (h : Hello) : List UInt8 := + be16 h.legacyVersion ++ h.random ++ + (h.sessionId.length.toUInt8 :: h.sessionId) ++ + (be16 (printPairs h.cipherSuites).length ++ + printPairs h.cipherSuites) ++ + (h.compressionMethods.length.toUInt8 :: + h.compressionMethods) ++ + (be16 (printExts h.extensions).length ++ + printExts h.extensions) + +/-- The handshake message in printed form: type 1, a three + byte length, and the body fields. -/ +def printBody (h : Hello) : List UInt8 := + (1 : UInt8) :: (be24 (printBodyFields h).length ++ + printBodyFields h) + +/-- The whole message in printed form: content type 22, the + legacy record version, a two byte length, and the + handshake message. -/ +def print (m : Message) : List UInt8 := + (22 : UInt8) :: (be16 m.recordVersion ++ + (be16 (printBody m.hello).length ++ printBody m.hello)) + +/-- Well formedness of one extension, at the level the + printer needs: every length it writes fits the field that + holds it, and the checks the parser makes on the value + hold. -/ +def ExtWF : Extension → Prop + | .serverName es => + es ≠ [] ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ + (e.1 = 0 → e.2 ≠ [])) ∧ + List.Nodup (es.map Prod.fst) ∧ + (printNameEntries es).length ≤ 65533 + | .alpn ns => + ns ≠ [] ∧ + (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ + (printAlpnNames ns).length ≤ 65533 + | .supportedVersions vs => + vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ vs.length ≤ 127 + | .keyShare ss => + ss ≠ [] ∧ + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) ∧ + (printShares ss).length ≤ 65533 + | .opaque t v => + ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ + t < 65536 ∧ v.length ≤ 65535 + +/-- A well formed message: every number fits the field that + holds it, every byte block holds the length its field + demands, the cipher suites and compression methods meet + their rules, every extension is well formed, and no + extension type stands twice. -/ +def WF (m : Message) : Prop := + m.recordVersion < 65536 ∧ + m.hello.legacyVersion < 65536 ∧ + m.hello.random.length = 32 ∧ + m.hello.sessionId.length ≤ 32 ∧ + m.hello.cipherSuites ≠ [] ∧ + (∀ v ∈ m.hello.cipherSuites, v < 65536) ∧ + m.hello.cipherSuites.length ≤ 32767 ∧ + m.hello.compressionMethods ≠ [] ∧ + (0 : UInt8) ∈ m.hello.compressionMethods ∧ + m.hello.compressionMethods.length ≤ 255 ∧ + (∀ e ∈ m.hello.extensions, ExtWF e) ∧ + List.Nodup (m.hello.extensions.map extType) ∧ + (printExts m.hello.extensions).length ≤ 65535 ∧ + (printBodyFields m.hello).length ≤ 65531 + +end ClientHello diff --git a/Main.lean b/Main.lean new file mode 100644 index 0000000..642c584 --- /dev/null +++ b/Main.lean @@ -0,0 +1,87 @@ +/- + Command line front end, used by the tests. + + Reads one request per line and prints one answer per line. A + request is an operation and its input as comma-separated + decimal byte codes. + + parse 22,3,3,... prints ok:22,3,3,... or none + + The one operation is `parse`. Its input is the byte codes of + a TLS record holding a ClientHello. Its answer is `ok:` and + the byte codes of the canonical reprint of the parsed + message, or `none` when the message is rejected. + + A request is an operation, then optionally one space and its + numbers; with no numbers after the space, the input is empty. + A malformed request prints `error`: any other line, an unknown + operation, a number that is not plain decimal digits, or a + code above 255, which no byte holds. A line may end in LF or + CR LF; nothing else around a request is ignored. + + The parsing and printing here call `ClientHello.parse` and + `ClientHello.print` directly. The line handling is covered by + the tests, not by a proof. +-/ + +import ClientHello + +open ClientHello + +/-- A number in plain decimal digits. Longer numbers than any + byte code are refused before they are converted, since + that takes time quadratic in their length. -/ +def number (t : String) : Option Nat := + let ds := t.toList + if ds.isEmpty || !ds.all Char.isDigit || (ds.dropWhile (· = '0')).length > 7 then none + else t.toNat? + +/-- The comma-separated numbers in `s`. -/ +def numbers (s : String) : Option (List Nat) := + if s.isEmpty then some [] else (s.splitOn ",").mapM number + +/-- The numbers as bytes. A number above 255 is not a byte, and + makes the request malformed. -/ +def toBytes (ns : List Nat) : Option (List UInt8) := + ns.mapM fun n => if n < 256 then some n.toUInt8 else none + +def showCodes (bs : List UInt8) : String := + ",".intercalate (bs.map fun b => toString b.toNat) + +/-- The answer to one request, or `none` when the request is + malformed. -/ +def answer (op : String) (ns : List Nat) : Option String := + match op with + | "parse" => + match toBytes ns with + | none => none + | some bs => + match parse bs with + | some v => some ("ok:" ++ showCodes (print v)) + | none => some "none" + | _ => none + +/-- The answer to one line: an operation, then optionally one + space and its numbers. -/ +def request (line : String) : Option String := + match line.splitOn " " with + | [op] => answer op [] + | [op, arg] => numbers arg >>= answer op + | _ => none + +/-- The line without its line ending: LF, or CR LF. -/ +def chomp (line : String) : String := + let cs := line.toList + if cs.getLast? = some '\n' then + let cs := cs.dropLast + String.ofList (if cs.getLast? = some '\r' then cs.dropLast else cs) + else line + +def main : IO Unit := do + let stdin ← IO.getStdin + let stdout ← IO.getStdout + repeat + let line ← stdin.getLine + if line.isEmpty then break + let line := chomp line + stdout.putStrLn ((request line).getD "error") diff --git a/Proofs.lean b/Proofs.lean new file mode 100644 index 0000000..b877d25 --- /dev/null +++ b/Proofs.lean @@ -0,0 +1,2 @@ +import Proofs.RoundTrip +import Proofs.Verify diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean new file mode 100644 index 0000000..6a4b0ab --- /dev/null +++ b/Proofs/RoundTrip.lean @@ -0,0 +1,2036 @@ +/- + The round trip proofs. + + Two claims are proved here, matching the plan's main claim + and its mirror: + + - `parse_print`: for every well formed message, parsing its + printed form gives the message back. + - `print_parse`: for every byte list the parser takes, + printing the parsed message gives the same bytes back. + The printer is canonical and the parser takes exactly the + canonical forms: every length is recomputed from the + value, and the value holds every byte the message + carried, so nothing is lost or added. + + The parser's safety, that it never reads past the end of + its input, is in the shape of the readers: every read is a + `take` whose length is checked first, or a match on bytes + that must be present. SPEC.md states it. +-/ + +import ClientHello + +namespace ClientHello.Proofs + +open ClientHello + +/-! ## Byte and number basics -/ + +/-- A byte printed from a number reads back as the number + modulo 256. -/ +theorem toUInt8_toNat (n : Nat) : (n.toUInt8).toNat = n % 256 := rfl + +/-- A byte's value fits in 256. -/ +theorem toNat_lt (b : UInt8) : b.toNat < 256 := UInt8.toNat_lt_size b + +/-- A byte rebuilt from its value is the byte. -/ +theorem toNat_toUInt8 (b : UInt8) : b.toNat.toUInt8 = b := by + apply UInt8.toNat_inj.mp + show (b.toNat.toUInt8).toNat = b.toNat + rw [toUInt8_toNat] + exact Nat.mod_eq_of_lt (toNat_lt b) + +/-- Two bytes printed from a value below 2^16 read back as + the value. -/ +theorem u16_be16 (n : Nat) (h : n < 65536) : + u16 (n / 256).toUInt8 n.toUInt8 = n := by + simp only [u16, toUInt8_toNat] + omega + +/-- The bytes read as a two byte value print back to those + bytes. -/ +theorem be16_u16 (a b : UInt8) : be16 (u16 a b) = [a, b] := by + have ha := toNat_lt a + have hb := toNat_lt b + have e1 : u16 a b / 256 = a.toNat := by + simp only [u16]; omega + have e2 : (u16 a b).toUInt8 = b := by + apply UInt8.toNat_inj.mp + show ((u16 a b).toUInt8).toNat = b.toNat + rw [toUInt8_toNat]; simp only [u16]; omega + simp only [be16, e1, e2, toNat_toUInt8] + +/-- Three bytes printed from a value below 2^24 read back as + the value. -/ +theorem u24_be24 (n : Nat) (h : n < 16777216) : + u24 (n / 65536).toUInt8 (n / 256).toUInt8 n.toUInt8 = n := by + simp only [u24, toUInt8_toNat] + omega + +/-- The bytes read as a three byte value print back to those + bytes. -/ +theorem be24_u24 (a b c : UInt8) : + be24 (u24 a b c) = [a, b, c] := by + have ha := toNat_lt a + have hb := toNat_lt b + have hc := toNat_lt c + have e1 : u24 a b c / 65536 = a.toNat := by + simp only [u24]; omega + have e2 : (u24 a b c / 256).toUInt8 = b := by + apply UInt8.toNat_inj.mp + show ((u24 a b c / 256).toUInt8).toNat = b.toNat + rw [toUInt8_toNat]; simp only [u24]; omega + have e3 : (u24 a b c).toUInt8 = c := by + apply UInt8.toNat_inj.mp + show ((u24 a b c).toUInt8).toNat = c.toNat + rw [toUInt8_toNat]; simp only [u24]; omega + simp only [be24, e1, e2, e3, toNat_toUInt8] + +/-! ## The readers, on printed forms and on read forms -/ + +/-- One step of the one byte reader, stated for rewriting. -/ +theorem getU8_cons (b : UInt8) (r : List UInt8) : + getU8 (b :: r) = some (b.toNat, r) := rfl + +/-- Reading two bytes off the front of a printed value and + what follows it. -/ +theorem getU16_be16 (n : Nat) (h : n < 65536) (r : List UInt8) : + getU16 (be16 n ++ r) = some (n, r) := by + show getU16 ((n / 256).toUInt8 :: n.toUInt8 :: r) = some (n, r) + show some (u16 (n / 256).toUInt8 n.toUInt8, r) = some (n, r) + rw [u16_be16 n h] + +/-- Reading three bytes off the front of a printed value and + what follows it. -/ +theorem getU24_be24 (n : Nat) (h : n < 16777216) + (r : List UInt8) : + getU24 (be24 n ++ r) = some (n, r) := by + show getU24 ((n / 65536).toUInt8 :: (n / 256).toUInt8 :: + n.toUInt8 :: r) = some (n, r) + show some (u24 (n / 65536).toUInt8 (n / 256).toUInt8 + n.toUInt8, r) = some (n, r) + rw [u24_be24 n h] + +/-- Reading a byte block off the front of a printed block and + what follows it. -/ +theorem getBytes_app {n : Nat} {v : List UInt8} (hv : v.length = n) + (r : List UInt8) : getBytes n (v ++ r) = some (v, r) := by + unfold getBytes + have ht : (v ++ r).take n = v := by + rw [← hv]; exact List.take_left + have hd : (v ++ r).drop n = r := by + rw [← hv]; exact List.drop_left + rw [ht, hd, if_pos hv] + +/-- A byte read by the one byte reader prints back as that + byte: the input was the byte and the rest. -/ +theorem getU8_inv {bs : List UInt8} {n : Nat} {r : List UInt8} + (h : getU8 bs = some (n, r)) : bs = n.toUInt8 :: r := by + cases bs with + | nil => simp [getU8] at h + | cons b r' => + have hstep : getU8 (b :: r') = some (b.toNat, r') := rfl + rw [hstep] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rw [toNat_toUInt8] + +/-- Bytes read by the two byte reader print back as those + bytes, and the value fits two bytes. -/ +theorem getU16_inv {bs : List UInt8} {n : Nat} {r : List UInt8} + (h : getU16 bs = some (n, r)) : + bs = be16 n ++ r ∧ n < 65536 := by + cases bs with + | nil => simp [getU16] at h + | cons a bs' => + cases bs' with + | nil => simp [getU16] at h + | cons b r' => + have hstep : getU16 (a :: b :: r') = some (u16 a b, r') := rfl + rw [hstep] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨?_, ?_⟩ + · simp only [be16_u16, List.cons_append, List.nil_append] + · have ha := toNat_lt a + have hb := toNat_lt b + simp only [u16]; omega + +/-- Bytes read by the three byte reader print back as those + bytes, and the value fits three bytes. -/ +theorem getU24_inv {bs : List UInt8} {n : Nat} {r : List UInt8} + (h : getU24 bs = some (n, r)) : + bs = be24 n ++ r ∧ n < 16777216 := by + cases bs with + | nil => simp [getU24] at h + | cons a bs' => + cases bs' with + | nil => simp [getU24] at h + | cons b bs'' => + cases bs'' with + | nil => simp [getU24] at h + | cons c r' => + have hstep : getU24 (a :: b :: c :: r') + = some (u24 a b c, r') := rfl + rw [hstep] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨?_, ?_⟩ + · simp only [be24_u24, List.cons_append, List.nil_append] + · have ha := toNat_lt a + have hb := toNat_lt b + have hc := toNat_lt c + simp only [u24]; omega + +/-- A block read by the block reader is its first `n` bytes, + and the rest is the rest: the input was the block and the + rest, and the block holds `n` bytes. -/ +theorem getBytes_inv {n : Nat} {bs v : List UInt8} + {r : List UInt8} (h : getBytes n bs = some (v, r)) : + v.length = n ∧ bs = v ++ r := by + unfold getBytes at h + by_cases hc : (bs.take n).length = n + · rw [if_pos hc] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨hc, (List.take_append_drop n bs).symm⟩ + · rw [if_neg hc] at h + simp at h + +/-! ## Two byte value lists: the cipher suites and the + supported versions -/ + +/-- The printed length of a two byte value list. -/ +theorem printPairs_length (vs : List Nat) : + (printPairs vs).length = 2 * vs.length := by + induction vs with + | nil => rfl + | cons v vs ih => + simp only [printPairs, be16, List.length_append, + List.length_cons, List.length_nil, ih] + omega + +/-- Printed two byte values read back as the values. -/ +theorem parsePairs_printPairs : + ∀ {vs : List Nat}, (∀ v ∈ vs, v < 65536) → + parsePairs (printPairs vs) = some vs := by + intro vs + induction vs with + | nil => intro _; rfl + | cons v vs ih => + intro hw + have hv : v < 65536 := hw v (by simp) + have htail : ∀ x ∈ vs, x < 65536 := + fun x hx => hw x (List.mem_cons_of_mem v hx) + show parsePairs (be16 v ++ printPairs vs) = some (v :: vs) + show parsePairs ((v / 256).toUInt8 :: v.toUInt8 :: + printPairs vs) = some (v :: vs) + show (parsePairs (printPairs vs)).map + (fun vs' => u16 (v / 256).toUInt8 v.toUInt8 :: vs') + = some (v :: vs) + rw [ih htail, u16_be16 v hv] + rfl + +/-- Two byte values a successful read gives print back to + the bytes they were read from, and each fits two bytes. + The induction is on the byte count, two at a time, since + the reader takes two bytes per value. -/ +theorem parsePairs_inv_aux : ∀ (n : Nat) (bs : List UInt8) + (vs : List Nat), bs.length = n → parsePairs bs = some vs → + printPairs vs = bs ∧ ∀ v ∈ vs, v < 65536 + | 0, bs, vs, hlen, h => by + cases bs with + | nil => + have h1 : parsePairs ([] : List UInt8) = some [] := rfl + rw [h1] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨rfl, by simp⟩ + | cons a bs' => simp at hlen + | 1, bs, vs, hlen, h => by + cases bs with + | nil => simp at hlen + | cons a bs' => + cases bs' with + | nil => simp [parsePairs] at h + | cons b rest => simp at hlen + | n + 2, bs, vs, hlen, h => by + cases bs with + | nil => simp at hlen + | cons a bs' => + cases bs' with + | nil => simp at hlen + | cons b rest => + have hrest : rest.length = n := by + simp only [List.length_cons] at hlen + omega + have hstep : parsePairs (a :: b :: rest) + = (parsePairs rest).map + (fun vs' => u16 a b :: vs') := rfl + rw [hstep] at h + obtain ⟨vs', hrec, hvs⟩ := Option.map_eq_some_iff.mp h + obtain ⟨hprint, hlt⟩ := + parsePairs_inv_aux n rest vs' hrest hrec + refine ⟨?_, ?_⟩ + · show printPairs vs = a :: b :: rest + rw [← hvs] + show printPairs (u16 a b :: vs') = a :: b :: rest + simp only [printPairs, be16_u16, List.cons_append, + List.nil_append, hprint] + · rw [← hvs] + intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · have ha := toNat_lt a + have hb := toNat_lt b + simp only [u16]; omega + · exact hlt x hx + +/-- Two byte values a successful read gives print back to + the bytes they were read from, and each fits two + bytes. -/ +theorem parsePairs_inv {bs : List UInt8} {vs : List Nat} + (h : parsePairs bs = some vs) : + printPairs vs = bs ∧ ∀ v ∈ vs, v < 65536 := + parsePairs_inv_aux bs.length bs vs rfl h + +/-- The count of values a successful two byte read gives, + from the byte count it read. -/ +theorem parsePairs_length {bs : List UInt8} {vs : List Nat} + (h : parsePairs bs = some vs) : + bs.length = 2 * vs.length := by + have h1 := (parsePairs_inv h).1 + rw [← h1, printPairs_length] + +/-! ## Server name entries -/ + +/-- The printed length of a server name entry list, one entry + at a time. -/ +theorem printNameEntries_length_cons (t : Nat) + (bs : List UInt8) (es : List (Nat × List UInt8)) : + (printNameEntries ((t, bs) :: es)).length + = bs.length + 3 + (printNameEntries es).length := by + simp only [printNameEntries, be16, List.length_append, + List.length_cons, List.length_nil] + omega + +/-- One step of the server name entry reader, stated for + rewriting. -/ +theorem parseNameEntriesGo_step (f : Nat) (t : UInt8) + (rest : List UInt8) : + parseNameEntriesGo (f + 1) (t :: rest) = + getU16 rest >>= fun (n, r1) => + if (r1.take n).length = n then + parseNameEntriesGo f (r1.drop n) >>= fun es => + if t.toNat ∈ es.map Prod.fst then none + else some ((t.toNat, r1.take n) :: es) + else none := rfl + +/-- Printed server name entries read back as the entries. -/ +theorem parseNameEntriesGo_print : + ∀ (es : List (Nat × List UInt8)) (fuel : Nat), + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535) → + List.Nodup (es.map Prod.fst) → + (printNameEntries es).length < fuel → + parseNameEntriesGo fuel (printNameEntries es) = some es := by + intro es + induction es with + | nil => + intro fuel _ _ hf + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + rfl + | cons e es ih => + intro fuel hw hnodup hf + obtain ⟨t, bs⟩ := e + have hhead : t < 256 ∧ bs.length ≤ 65535 := + hw (t, bs) (by simp) + have htail : ∀ x ∈ es, x.1 < 256 ∧ x.2.length ≤ 65535 := + fun x hx => hw x (List.mem_cons_of_mem (t, bs) hx) + have hnodup' : List.Nodup (es.map Prod.fst) := by + have h2 : ((t, bs) :: es).map Prod.fst + = t :: es.map Prod.fst := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).2 + have hnotin : t ∉ es.map Prod.fst := by + have h2 : ((t, bs) :: es).map Prod.fst + = t :: es.map Prod.fst := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).1 + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + have hf' : (printNameEntries es).length < f := by + have hflen : (printNameEntries ((t, bs) :: es)).length + = bs.length + 3 + (printNameEntries es).length := + printNameEntries_length_cons t bs es + omega + have ht : (t.toUInt8).toNat = t := by + rw [toUInt8_toNat] + exact Nat.mod_eq_of_lt hhead.1 + show parseNameEntriesGo (f + 1) + ((t.toUInt8 :: (be16 bs.length ++ bs)) ++ + printNameEntries es) + = some ((t, bs) :: es) + have hform : (t.toUInt8 :: (be16 bs.length ++ bs)) ++ + printNameEntries es + = t.toUInt8 :: (bs.length / 256).toUInt8 :: + bs.length.toUInt8 :: (bs ++ printNameEntries es) := by + simp only [be16, List.cons_append, List.nil_append] + rw [hform, parseNameEntriesGo_step] + show (getU16 ((bs.length / 256).toUInt8 :: + bs.length.toUInt8 :: (bs ++ printNameEntries es)) >>= + fun (n, r1) => + if (r1.take n).length = n then + parseNameEntriesGo f (r1.drop n) >>= fun es' => + if (t.toUInt8).toNat ∈ es'.map Prod.fst then none + else some (((t.toUInt8).toNat, r1.take n) :: es') + else none) = some ((t, bs) :: es) + have hg : getU16 ((bs.length / 256).toUInt8 :: + bs.length.toUInt8 :: (bs ++ printNameEntries es)) + = some (bs.length, bs ++ printNameEntries es) := by + show some (u16 (bs.length / 256).toUInt8 + bs.length.toUInt8, bs ++ printNameEntries es) = _ + rw [u16_be16 bs.length (by omega)] + rw [hg] + simp only [Option.bind_some] + show (if ((bs ++ printNameEntries es).take bs.length).length + = bs.length then + parseNameEntriesGo f ((bs ++ printNameEntries es).drop + bs.length) >>= fun es' => + if (t.toUInt8).toNat ∈ es'.map Prod.fst then none + else some (((t.toUInt8).toNat, + (bs ++ printNameEntries es).take bs.length) :: es') + else none) = some ((t, bs) :: es) + rw [List.take_left, List.drop_left, if_pos rfl, + ih f htail hnodup' hf'] + show (if (t.toUInt8).toNat ∈ es.map Prod.fst then none + else some (((t.toUInt8).toNat, bs) :: es)) + = some ((t, bs) :: es) + rw [if_neg (by rw [ht]; exact hnotin), ht] + +/-- Printed server name entries read back, at the top + level. -/ +theorem parseNameEntries_print {es : List (Nat × List UInt8)} + (hw : ∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535) + (hn : List.Nodup (es.map Prod.fst)) : + parseNameEntries (printNameEntries es) = some es := by + show parseNameEntriesGo ((printNameEntries es).length + 1) + (printNameEntries es) = some es + exact parseNameEntriesGo_print es _ hw hn (Nat.lt_succ_self _) + +/-- Server name entries a successful read gives print back + to the bytes they were read from, each name type fits + one byte, each name fits two length bytes, and no name + type stands twice. -/ +theorem parseNameEntriesGo_inv : + ∀ (f : Nat) (bs : List UInt8) + (es : List (Nat × List UInt8)), + parseNameEntriesGo f bs = some es → + printNameEntries es = bs ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535) ∧ + List.Nodup (es.map Prod.fst) := by + intro f + induction f with + | zero => + intro bs es h + simp [parseNameEntriesGo] at h + | succ f ih => + intro bs es h + cases bs with + | nil => + have h1 : parseNameEntriesGo (f + 1) ([] : List UInt8) + = some [] := rfl + rw [h1] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨rfl, by simp, by simp⟩ + | cons t rest => + rw [parseNameEntriesGo_step] at h + obtain ⟨⟨n, r1⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if (r1.take n).length = n then + parseNameEntriesGo f (r1.drop n) >>= fun es' => + if t.toNat ∈ es'.map Prod.fst then none + else some ((t.toNat, r1.take n) :: es') + else none) = some es at h + obtain ⟨hrest, hnlt⟩ := getU16_inv hn + by_cases hc : (r1.take n).length = n + · rw [if_pos hc] at h + obtain ⟨es', hrec, h⟩ := + Option.bind_eq_some_iff.mp h + obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec + by_cases hd : t.toNat ∈ es'.map Prod.fst + · rw [if_pos hd] at h + simp at h + · rw [if_neg hd] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨?_, ?_, ?_⟩ + · show printNameEntries ((t.toNat, r1.take n) :: es') + = t :: rest + have htake : (r1.take n).length = n := hc + show ((t.toNat.toUInt8 :: + (be16 (r1.take n).length ++ r1.take n)) ++ + printNameEntries es') = t :: rest + rw [htake, hprint, toNat_toUInt8, hrest] + show (t :: ((be16 n ++ r1.take n) ++ r1.drop n)) + = t :: (be16 n ++ r1) + rw [List.append_assoc, List.take_append_drop] + · intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact ⟨toNat_lt t, by rw [hc]; omega⟩ + · exact hprops x hx + · have h2 : ((t.toNat, r1.take n) :: es').map Prod.fst + = t.toNat :: es'.map Prod.fst := rfl + rw [h2] + exact List.nodup_cons.mpr ⟨hd, hnodup⟩ + · rw [if_neg hc] at h + simp at h + +/-- Server name entries a successful read gives print back, + at the top level. -/ +theorem parseNameEntries_inv {bs : List UInt8} + {es : List (Nat × List UInt8)} + (h : parseNameEntries bs = some es) : + printNameEntries es = bs ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535) ∧ + List.Nodup (es.map Prod.fst) := + parseNameEntriesGo_inv _ _ _ h + +/-- The server name value check holds for a list the printer + can write: nonempty, and every host_name entry + nonempty. -/ +theorem validNames_of {es : List (Nat × List UInt8)} + (hne : es ≠ []) + (hhost : ∀ e ∈ es, e.1 = 0 → e.2 ≠ []) : + validNames es = true := by + unfold validNames + rw [Bool.and_eq_true] + constructor + · cases es with + | nil => exact absurd rfl hne + | cons e es' => rfl + · rw [List.all_eq_true] + intro e he + simp only [decide_eq_true_eq] + by_cases h0 : e.1 = 0 + · exact Or.inr (hhost e he h0) + · exact Or.inl h0 + +/-- A server name list that passes the value check is + nonempty, and its host_name entries are nonempty. -/ +theorem validNames_true {es : List (Nat × List UInt8)} + (h : validNames es = true) : + es ≠ [] ∧ ∀ e ∈ es, e.1 = 0 → e.2 ≠ [] := by + have hne : es ≠ [] := by + cases es with + | nil => simp [validNames] at h + | cons e es' => simp + have hall : ∀ e ∈ es, e.1 ≠ 0 ∨ e.2 ≠ [] := by + have h2 : es.all + (fun e => decide (e.1 ≠ 0 ∨ e.2 ≠ [])) = true := by + have h' : (!es.isEmpty && + es.all (fun e => decide (e.1 ≠ 0 ∨ e.2 ≠ []))) + = true := h + rw [Bool.and_eq_true] at h' + exact h'.2 + rw [List.all_eq_true] at h2 + intro e he + have h3 := h2 e he + simpa only [decide_eq_true_eq] using h3 + exact ⟨hne, fun e he h0 => + (hall e he).elim (fun hn => absurd h0 hn) id⟩ + +/-! ## The server_name value -/ + +/-- A printed server_name value reads back as the + extension. -/ +theorem parseSNI_print {es : List (Nat × List UInt8)} + (hne : es ≠ []) + (hw : ∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ + (e.1 = 0 → e.2 ≠ [])) + (hnodup : List.Nodup (es.map Prod.fst)) + (hlen : (printNameEntries es).length ≤ 65533) : + parseSNI (printExtValue (.serverName es)) + = some (.serverName es) := by + have hw' : ∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 := + fun e he => ⟨(hw e he).1, (hw e he).2.1⟩ + show parseSNI (be16 (printNameEntries es).length ++ + printNameEntries es) = some (Extension.serverName es) + unfold parseSNI + rw [getU16_be16 _ (by omega)] + simp only [Option.bind_some] + show (if (printNameEntries es).length + = (printNameEntries es).length then + parseNameEntries (printNameEntries es) >>= fun es' => + if validNames es' then some (Extension.serverName es') else none + else none) = some (Extension.serverName es) + rw [if_pos rfl, parseNameEntries_print hw' hnodup] + show (if validNames es then some (Extension.serverName es) + else none) = some (Extension.serverName es) + rw [if_pos (validNames_of hne (fun e he => (hw e he).2.2))] + +/-- A server_name value a successful read gives is the + printed form of the extension it gives, and the + extension is well formed. The value length bound comes + from the caller: an extension value fits two length + bytes. -/ +theorem parseSNI_inv {v : List UInt8} {e : Extension} + (hv : v.length ≤ 65535) (h : parseSNI v = some e) : + ∃ es, e = .serverName es ∧ + printExtValue (.serverName es) = v ∧ + ExtWF (.serverName es) := by + unfold parseSNI at h + obtain ⟨⟨n, rest⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if rest.length = n then + parseNameEntries rest >>= fun es => + if validNames es then some (.serverName es) else none + else none) = some e at h + obtain ⟨hrest, hnlt⟩ := getU16_inv hn + by_cases hc : rest.length = n + · rw [if_pos hc] at h + obtain ⟨es, hrec, h⟩ := Option.bind_eq_some_iff.mp h + by_cases hval : validNames es = true + · rw [if_pos hval] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hprint, hprops, hnodup⟩ := parseNameEntries_inv hrec + obtain ⟨hne, hhost⟩ := validNames_true hval + refine ⟨es, rfl, ?_, ?_⟩ + · show be16 (printNameEntries es).length ++ + printNameEntries es = v + rw [hprint, hc, hrest] + · exact ⟨hne, fun x hx => + ⟨(hprops x hx).1, (hprops x hx).2, hhost x hx⟩, + hnodup, by + have h2 : (printNameEntries es).length = rest.length := by + rw [hprint] + have hvlen : v.length = rest.length + 2 := by + rw [hrest]; simp [be16] + omega⟩ + · rw [if_neg hval] at h + simp at h + · rw [if_neg hc] at h + simp at h + +/-! ## ALPN protocol names -/ + +/-- The printed length of an ALPN name list, one name at a + time. -/ +theorem printAlpnNames_length_cons (n : List UInt8) + (ns : List (List UInt8)) : + (printAlpnNames (n :: ns)).length + = n.length + 1 + (printAlpnNames ns).length := by + simp only [printAlpnNames, List.length_append, + List.length_cons] + +/-- One step of the ALPN name reader, stated for + rewriting. -/ +theorem parseAlpnGo_step (f : Nat) (len : UInt8) + (rest : List UInt8) : + parseAlpnGo (f + 1) (len :: rest) = + if len.toNat = 0 then none + else if (rest.take len.toNat).length = len.toNat then + (parseAlpnGo f (rest.drop len.toNat)).map + (fun ns => (rest.take len.toNat) :: ns) + else none := rfl + +/-- Printed ALPN names read back as the names. -/ +theorem parseAlpnGo_print : + ∀ (ns : List (List UInt8)) (fuel : Nat), + (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) → + (printAlpnNames ns).length < fuel → + parseAlpnGo fuel (printAlpnNames ns) = some ns := by + intro ns + induction ns with + | nil => + intro fuel _ hf + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + rfl + | cons n ns ih => + intro fuel hw hf + have hhead : n ≠ [] ∧ n.length ≤ 255 := hw n (by simp) + have htail : ∀ x ∈ ns, x ≠ [] ∧ x.length ≤ 255 := + fun x hx => hw x (List.mem_cons_of_mem n hx) + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + have hf' : (printAlpnNames ns).length < f := by + have hflen : (printAlpnNames (n :: ns)).length + = n.length + 1 + (printAlpnNames ns).length := + printAlpnNames_length_cons n ns + omega + have hlen : (n.length.toUInt8).toNat = n.length := by + rw [toUInt8_toNat] + exact Nat.mod_eq_of_lt (by omega) + show parseAlpnGo (f + 1) + ((n.length.toUInt8 :: n) ++ printAlpnNames ns) + = some (n :: ns) + have hform : (n.length.toUInt8 :: n) ++ printAlpnNames ns + = n.length.toUInt8 :: (n ++ printAlpnNames ns) := by + simp only [List.cons_append, List.nil_append] + rw [hform, parseAlpnGo_step, hlen, + if_neg (by + intro hcon + cases n with + | nil => exact hhead.1 rfl + | cons b bs => simp at hcon), + List.take_left, List.drop_left, if_pos rfl, ih f htail hf'] + rfl + +/-- Printed ALPN names read back, at the top level. -/ +theorem parseAlpnNames_print {ns : List (List UInt8)} + (hw : ∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) : + parseAlpnNames (printAlpnNames ns) = some ns := by + show parseAlpnGo ((printAlpnNames ns).length + 1) + (printAlpnNames ns) = some ns + exact parseAlpnGo_print ns _ hw (Nat.lt_succ_self _) + +/-- ALPN names a successful read gives print back to the + bytes they were read from, and each name is nonempty + and fits one length byte. -/ +theorem parseAlpnGo_inv : + ∀ (f : Nat) (bs : List UInt8) (ns : List (List UInt8)), + parseAlpnGo f bs = some ns → + printAlpnNames ns = bs ∧ + ∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255 := by + intro f + induction f with + | zero => + intro bs ns h + simp [parseAlpnGo] at h + | succ f ih => + intro bs ns h + cases bs with + | nil => + have h1 : parseAlpnGo (f + 1) ([] : List UInt8) + = some [] := rfl + rw [h1] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨rfl, by simp⟩ + | cons len rest => + rw [parseAlpnGo_step] at h + by_cases h0 : len.toNat = 0 + · rw [if_pos h0] at h + simp at h + · rw [if_neg h0] at h + by_cases hc : (rest.take len.toNat).length = len.toNat + · rw [if_pos hc] at h + obtain ⟨ns', hrec, hns⟩ := Option.map_eq_some_iff.mp h + obtain ⟨hprint, hprops⟩ := ih _ _ hrec + refine ⟨?_, ?_⟩ + · show printAlpnNames ns = len :: rest + rw [← hns] + show printAlpnNames ((rest.take len.toNat) :: ns') + = len :: rest + have htake : (rest.take len.toNat).length + = len.toNat := hc + show ((rest.take len.toNat).length.toUInt8 :: + rest.take len.toNat) ++ printAlpnNames ns' + = len :: rest + rw [htake, toNat_toUInt8, hprint] + show len :: (rest.take len.toNat ++ rest.drop len.toNat) + = len :: rest + rw [List.take_append_drop] + · intro x hx + rw [← hns] at hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · refine ⟨?_, by rw [hc]; have h := toNat_lt len; omega⟩ + intro hcon + rw [hcon] at hc + simp at hc + omega + · exact hprops x hx + · rw [if_neg hc] at h + simp at h + +/-- ALPN names a successful read gives print back, at the + top level. -/ +theorem parseAlpnNames_inv {bs : List UInt8} + {ns : List (List UInt8)} + (h : parseAlpnNames bs = some ns) : + printAlpnNames ns = bs ∧ + ∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255 := + parseAlpnGo_inv _ _ _ h + +/-- A printed ALPN value reads back as the extension. -/ +theorem parseALPN_print {ns : List (List UInt8)} + (hne : ns ≠ []) + (hw : ∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) + (hlen : (printAlpnNames ns).length ≤ 65533) : + parseALPN (printExtValue (.alpn ns)) = some (.alpn ns) := by + show parseALPN (be16 (printAlpnNames ns).length ++ + printAlpnNames ns) = some (Extension.alpn ns) + unfold parseALPN + rw [getU16_be16 _ (by omega)] + simp only [Option.bind_some] + show (if (printAlpnNames ns).length + = (printAlpnNames ns).length then + parseAlpnNames (printAlpnNames ns) >>= fun ns' => + if ns'.isEmpty then none else some (Extension.alpn ns') + else none) = some (Extension.alpn ns) + rw [if_pos rfl, parseAlpnNames_print hw] + show (if ns.isEmpty then none else some (Extension.alpn ns)) + = some (Extension.alpn ns) + rw [if_neg (by + cases ns with + | nil => exact absurd rfl hne + | cons n ns' => simp)] + +/-- An ALPN value a successful read gives is the printed + form of the extension it gives, and the extension is + well formed. -/ +theorem parseALPN_inv {v : List UInt8} {e : Extension} + (hv : v.length ≤ 65535) (h : parseALPN v = some e) : + ∃ ns, e = .alpn ns ∧ + printExtValue (.alpn ns) = v ∧ ExtWF (.alpn ns) := by + unfold parseALPN at h + obtain ⟨⟨n, rest⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if rest.length = n then + parseAlpnNames rest >>= fun ns => + if ns.isEmpty then none else some (.alpn ns) + else none) = some e at h + obtain ⟨hrest, hnlt⟩ := getU16_inv hn + by_cases hc : rest.length = n + · rw [if_pos hc] at h + obtain ⟨ns, hrec, h⟩ := Option.bind_eq_some_iff.mp h + by_cases hemp : ns.isEmpty = false + · rw [if_neg (by + intro hcon + rw [hcon] at hemp + simp at hemp)] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hprint, hprops⟩ := parseAlpnNames_inv hrec + have hne : ns ≠ [] := by + cases ns with + | nil => simp at hemp + | cons n' ns' => simp + refine ⟨ns, rfl, ?_, ?_⟩ + · show be16 (printAlpnNames ns).length ++ + printAlpnNames ns = v + rw [hprint, hc, hrest] + · exact ⟨hne, hprops, by + have h2 : (printAlpnNames ns).length = rest.length := by + rw [hprint] + have hvlen : v.length = rest.length + 2 := by + rw [hrest]; simp [be16] + omega⟩ + · have hemp2 : ns.isEmpty = true := by + cases h' : ns.isEmpty with + | true => rfl + | false => exact absurd h' hemp + rw [if_pos hemp2] at h + simp at h + · rw [if_neg hc] at h + simp at h + +/-! ## The supported_versions value -/ + +/-- A printed supported_versions value reads back as the + extension. -/ +theorem parseSV_print {vs : List Nat} + (hne : vs ≠ []) (hw : ∀ v ∈ vs, v < 65536) + (hlen : vs.length ≤ 127) : + parseSV (printExtValue (.supportedVersions vs)) + = some (.supportedVersions vs) := by + show parseSV ((printPairs vs).length.toUInt8 :: + printPairs vs) = some (.supportedVersions vs) + have hlen2 : ((printPairs vs).length.toUInt8).toNat + = (printPairs vs).length := by + rw [toUInt8_toNat, printPairs_length] + have : 2 * vs.length < 256 := by omega + exact Nat.mod_eq_of_lt this + have hcond : (printPairs vs).length + = ((printPairs vs).length.toUInt8).toNat ∧ + ((printPairs vs).length.toUInt8).toNat % 2 = 0 ∧ + 2 ≤ ((printPairs vs).length.toUInt8).toNat := by + rw [hlen2, printPairs_length] + refine ⟨rfl, by omega, by + cases vs with + | nil => exact absurd rfl hne + | cons v vs' => simp; omega⟩ + show (if (printPairs vs).length + = ((printPairs vs).length.toUInt8).toNat ∧ + ((printPairs vs).length.toUInt8).toNat % 2 = 0 ∧ + 2 ≤ ((printPairs vs).length.toUInt8).toNat then + parsePairs (printPairs vs) >>= fun vs' => + some (Extension.supportedVersions vs') + else none) = some (Extension.supportedVersions vs) + rw [if_pos hcond, parsePairs_printPairs hw] + rfl + +/-- A supported_versions value a successful read gives is + the printed form of the extension it gives, and the + extension is well formed. -/ +theorem parseSV_inv {v : List UInt8} {e : Extension} + (h : parseSV v = some e) : + ∃ vs, e = .supportedVersions vs ∧ + printExtValue (.supportedVersions vs) = v ∧ + ExtWF (.supportedVersions vs) := by + cases v with + | nil => simp [parseSV] at h + | cons n rest => + have hstep : parseSV (n :: rest) = + if rest.length = n.toNat ∧ n.toNat % 2 = 0 ∧ + 2 ≤ n.toNat then + parsePairs rest >>= fun vs => + some (.supportedVersions vs) + else none := rfl + rw [hstep] at h + by_cases hc : rest.length = n.toNat ∧ n.toNat % 2 = 0 ∧ + 2 ≤ n.toNat + · rw [if_pos hc] at h + obtain ⟨vs, hrec, h⟩ := Option.bind_eq_some_iff.mp h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hprint, hlt⟩ := parsePairs_inv hrec + have hlen := parsePairs_length hrec + refine ⟨vs, rfl, ?_, ?_⟩ + · show (printPairs vs).length.toUInt8 :: printPairs vs + = n :: rest + rw [hprint] + have hbyte : (rest.length).toUInt8 = n := by + apply UInt8.toNat_inj.mp + show ((rest.length).toUInt8).toNat = n.toNat + rw [toUInt8_toNat, hc.1] + exact Nat.mod_eq_of_lt (toNat_lt n) + rw [hbyte] + · refine ⟨?_, hlt, by + have h1 := hc.1 + have h2 := toNat_lt n + omega⟩ + cases vs with + | nil => + intro hcon + have h5 := (parsePairs_inv hrec).1 + simp only [printPairs] at h5 + have hz : rest.length = 0 := by + rw [← h5] + simp [printPairs] + have h1 := hc.1 + have h3 := hc.2.2 + omega + | cons v' vs' => intro hcon; cases hcon + · rw [if_neg hc] at h + simp at h + +/-! ## Key share entries -/ + +/-- The printed length of a key share entry list, one entry + at a time. -/ +theorem printShares_length_cons (g : Nat) (k : List UInt8) + (ss : List (Nat × List UInt8)) : + (printShares ((g, k) :: ss)).length + = k.length + 4 + (printShares ss).length := by + show ((be16 g ++ (be16 k.length ++ k)) ++ + printShares ss).length = _ + rw [List.length_append, List.length_append, + List.length_append] + simp only [be16, List.length_cons, List.length_nil] + omega + +/-- One step of the key share entry reader, stated for + rewriting. -/ +theorem parseSharesGo_step (f : Nat) (x y : UInt8) + (rest : List UInt8) : + parseSharesGo (f + 1) (x :: y :: rest) = + getU16 (x :: y :: rest) >>= fun (g, r1) => + getU16 r1 >>= fun (n, r2) => + if n = 0 then none + else if (r2.take n).length = n then + parseSharesGo f (r2.drop n) >>= fun ss => + if g ∈ ss.map Prod.fst then none + else some ((g, r2.take n) :: ss) + else none := rfl + +/-- Printed key share entries read back as the entries. -/ +theorem parseSharesGo_print : + ∀ (ss : List (Nat × List UInt8)) (fuel : Nat), + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) → + List.Nodup (ss.map Prod.fst) → + (printShares ss).length < fuel → + parseSharesGo fuel (printShares ss) = some ss := by + intro ss + induction ss with + | nil => + intro fuel _ _ hf + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + rfl + | cons s ss ih => + intro fuel hw hnodup hf + obtain ⟨g, k⟩ := s + have hhead : g < 65536 ∧ k ≠ [] ∧ k.length ≤ 65535 := + hw (g, k) (by simp) + have htail : ∀ x ∈ ss, x.1 < 65536 ∧ x.2 ≠ [] ∧ + x.2.length ≤ 65535 := + fun x hx => hw x (List.mem_cons_of_mem (g, k) hx) + have hnodup' : List.Nodup (ss.map Prod.fst) := by + have h2 : ((g, k) :: ss).map Prod.fst + = g :: ss.map Prod.fst := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).2 + have hnotin : g ∉ ss.map Prod.fst := by + have h2 : ((g, k) :: ss).map Prod.fst + = g :: ss.map Prod.fst := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).1 + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + have hf' : (printShares ss).length < f := by + have hflen : (printShares ((g, k) :: ss)).length + = k.length + 4 + (printShares ss).length := + printShares_length_cons g k ss + omega + show parseSharesGo (f + 1) + ((be16 g ++ (be16 k.length ++ k)) ++ printShares ss) + = some ((g, k) :: ss) + have hform : (be16 g ++ (be16 k.length ++ k)) ++ + printShares ss + = be16 g ++ (be16 k.length ++ (k ++ printShares ss)) := by + simp only [← List.append_assoc] + rw [hform] + show parseSharesGo (f + 1) ((g / 256).toUInt8 :: + g.toUInt8 :: ((k.length / 256).toUInt8 :: + k.length.toUInt8 :: (k ++ printShares ss))) + = some ((g, k) :: ss) + rw [parseSharesGo_step] + have hg : getU16 ((g / 256).toUInt8 :: g.toUInt8 :: + ((k.length / 256).toUInt8 :: k.length.toUInt8 :: + (k ++ printShares ss))) + = some (g, (k.length / 256).toUInt8 :: + k.length.toUInt8 :: (k ++ printShares ss)) := by + show some (u16 (g / 256).toUInt8 g.toUInt8, _) = _ + rw [u16_be16 g hhead.1] + rw [hg] + simp only [Option.bind_some] + show (getU16 ((k.length / 256).toUInt8 :: + k.length.toUInt8 :: (k ++ printShares ss)) >>= + fun (n, r2) => + if n = 0 then none + else if (r2.take n).length = n then + parseSharesGo f (r2.drop n) >>= fun ss' => + if g ∈ ss'.map Prod.fst then none + else some ((g, r2.take n) :: ss') + else none) = some ((g, k) :: ss) + have hk : getU16 ((k.length / 256).toUInt8 :: + k.length.toUInt8 :: (k ++ printShares ss)) + = some (k.length, k ++ printShares ss) := by + show some (u16 (k.length / 256).toUInt8 + k.length.toUInt8, _) = _ + rw [u16_be16 _ (by omega)] + rw [hk] + simp only [Option.bind_some] + show (if k.length = 0 then none + else if ((k ++ printShares ss).take k.length).length + = k.length then + parseSharesGo f ((k ++ printShares ss).drop + k.length) >>= fun ss' => + if g ∈ ss'.map Prod.fst then none + else some ((g, (k ++ printShares ss).take + k.length) :: ss') + else none) = some ((g, k) :: ss) + rw [if_neg (by + intro hcon + cases k with + | nil => exact hhead.2.1 rfl + | cons b bs => simp at hcon), + List.take_left, List.drop_left, if_pos rfl, + ih f htail hnodup' hf'] + show (if g ∈ ss.map Prod.fst then none + else some ((g, k) :: ss)) = some ((g, k) :: ss) + rw [if_neg hnotin] + +/-- Printed key share entries read back, at the top + level. -/ +theorem parseShares_print {ss : List (Nat × List UInt8)} + (hw : ∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) + (hn : List.Nodup (ss.map Prod.fst)) : + parseShares (printShares ss) = some ss := by + show parseSharesGo ((printShares ss).length + 1) + (printShares ss) = some ss + exact parseSharesGo_print ss _ hw hn (Nat.lt_succ_self _) + +/-- Key share entries a successful read gives print back to + the bytes they were read from, each group fits two + bytes, each key is nonempty and fits two length bytes, + and no group stands twice. -/ +theorem parseSharesGo_inv : + ∀ (f : Nat) (bs : List UInt8) + (ss : List (Nat × List UInt8)), + parseSharesGo f bs = some ss → + printShares ss = bs ∧ + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) := by + intro f + induction f with + | zero => + intro bs ss h + simp [parseSharesGo] at h + | succ f ih => + intro bs ss h + cases bs with + | nil => + have h1 : parseSharesGo (f + 1) ([] : List UInt8) + = some [] := rfl + rw [h1] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨rfl, by simp, by simp⟩ + | cons b1 rest => + cases rest with + | nil => simp [parseSharesGo, getU16] at h + | cons b2 rest => + rw [parseSharesGo_step] at h + obtain ⟨⟨g, r1⟩, hg, h⟩ := Option.bind_eq_some_iff.mp h + change (getU16 r1 >>= fun (n, r2) => + if n = 0 then none + else if (r2.take n).length = n then + parseSharesGo f (r2.drop n) >>= fun ss => + if g ∈ ss.map Prod.fst then none + else some ((g, r2.take n) :: ss) + else none) = some ss at h + obtain ⟨⟨n, r2⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if n = 0 then none + else if (r2.take n).length = n then + parseSharesGo f (r2.drop n) >>= fun ss' => + if g ∈ ss'.map Prod.fst then none + else some ((g, r2.take n) :: ss') + else none) = some ss at h + obtain ⟨hbs, hglt⟩ := getU16_inv hg + obtain ⟨hr1, hnlt⟩ := getU16_inv hn + by_cases h0 : n = 0 + · rw [if_pos h0] at h + simp at h + · rw [if_neg h0] at h + by_cases hc : (r2.take n).length = n + · rw [if_pos hc] at h + obtain ⟨ss', hrec, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec + by_cases hd : g ∈ ss'.map Prod.fst + · rw [if_pos hd] at h + simp at h + · rw [if_neg hd] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + refine ⟨?_, ?_, ?_⟩ + · have htake : (r2.take n).length = n := hc + show ((be16 g ++ (be16 (r2.take n).length ++ + r2.take n)) ++ printShares ss') + = b1 :: b2 :: rest + rw [htake, hprint, hbs, hr1] + simp only [List.append_assoc] + rw [List.take_append_drop] + · intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact ⟨hglt, by + intro hcon + change r2.take n = [] at hcon + rw [hcon] at hc + exact h0 hc.symm, by + change (r2.take n).length ≤ 65535 + rw [hc]; omega⟩ + · exact hprops x hx + · have h2 : ((g, r2.take n) :: ss').map Prod.fst + = g :: ss'.map Prod.fst := rfl + rw [h2] + exact List.nodup_cons.mpr ⟨hd, hnodup⟩ + · rw [if_neg hc] at h + simp at h + +/-- Key share entries a successful read gives print back, + at the top level. -/ +theorem parseShares_inv {bs : List UInt8} + {ss : List (Nat × List UInt8)} + (h : parseShares bs = some ss) : + printShares ss = bs ∧ + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) := + parseSharesGo_inv _ _ _ h + +/-- A printed key_share value reads back as the + extension. -/ +theorem parseKS_print {ss : List (Nat × List UInt8)} + (hne : ss ≠ []) + (hw : ∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) + (hnodup : List.Nodup (ss.map Prod.fst)) + (hlen : (printShares ss).length ≤ 65533) : + parseKS (printExtValue (.keyShare ss)) + = some (.keyShare ss) := by + show parseKS (be16 (printShares ss).length ++ + printShares ss) = some (Extension.keyShare ss) + unfold parseKS + rw [getU16_be16 _ (by omega)] + simp only [Option.bind_some] + show (if (printShares ss).length + = (printShares ss).length then + parseShares (printShares ss) >>= fun ss' => + if ss'.isEmpty then none else some (Extension.keyShare ss') + else none) = some (Extension.keyShare ss) + rw [if_pos rfl, parseShares_print hw hnodup] + show (if ss.isEmpty then none else some (Extension.keyShare ss)) + = some (Extension.keyShare ss) + rw [if_neg (by + cases ss with + | nil => exact absurd rfl hne + | cons s ss' => simp)] + +/-- A key_share value a successful read gives is the + printed form of the extension it gives, and the + extension is well formed. -/ +theorem parseKS_inv {v : List UInt8} {e : Extension} + (hv : v.length ≤ 65535) (h : parseKS v = some e) : + ∃ ss, e = .keyShare ss ∧ + printExtValue (.keyShare ss) = v ∧ + ExtWF (.keyShare ss) := by + unfold parseKS at h + obtain ⟨⟨n, rest⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if rest.length = n then + parseShares rest >>= fun ss => + if ss.isEmpty then none else some (.keyShare ss) + else none) = some e at h + obtain ⟨hrest, hnlt⟩ := getU16_inv hn + by_cases hc : rest.length = n + · rw [if_pos hc] at h + obtain ⟨ss, hrec, h⟩ := Option.bind_eq_some_iff.mp h + by_cases hemp : ss.isEmpty = false + · rw [if_neg (by + intro hcon + rw [hcon] at hemp + simp at hemp)] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hprint, hprops, hnodup⟩ := parseShares_inv hrec + have hne : ss ≠ [] := by + cases ss with + | nil => simp at hemp + | cons s' ss' => intro hcon; cases hcon + refine ⟨ss, rfl, ?_, ?_⟩ + · show be16 (printShares ss).length ++ + printShares ss = v + rw [hprint, hc, hrest] + · exact ⟨hne, hprops, hnodup, by + have h2 : (printShares ss).length = rest.length := by + rw [hprint] + have hvlen : v.length = rest.length + 2 := by + rw [hrest]; simp [be16] + omega⟩ + · have hemp2 : ss.isEmpty = true := by + cases h' : ss.isEmpty with + | true => rfl + | false => exact absurd h' hemp + rw [if_pos hemp2] at h + simp at h + · rw [if_neg hc] at h + simp at h + +/-! ## Extension values, dispatched by type -/ + +/-- The type of a well formed extension fits two bytes. -/ +theorem extType_lt {e : Extension} (h : ExtWF e) : + extType e < 65536 := by + rcases e with ⟨es⟩ | ⟨ns⟩ | ⟨vs⟩ | ⟨ss⟩ | ⟨t, v⟩ + · show (0 : Nat) < 65536; omega + · show (16 : Nat) < 65536; omega + · show (43 : Nat) < 65536; omega + · show (51 : Nat) < 65536; omega + · have h' : ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ + t < 65536 ∧ v.length ≤ 65535 := h + exact h'.2.1 + +/-- The printed value of a well formed extension fits two + length bytes. -/ +theorem printExtValue_length_le {e : Extension} + (h : ExtWF e) : (printExtValue e).length ≤ 65535 := by + rcases e with ⟨es⟩ | ⟨ns⟩ | ⟨vs⟩ | ⟨ss⟩ | ⟨t, v⟩ + · + have h' : es ≠ [] ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ + (e.1 = 0 → e.2 ≠ [])) ∧ + List.Nodup (es.map Prod.fst) ∧ + (printNameEntries es).length ≤ 65533 := h + show (be16 (printNameEntries es).length ++ + printNameEntries es).length ≤ 65535 + rw [List.length_append] + simp [be16] + omega + · have h' : ns ≠ [] ∧ + (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ + (printAlpnNames ns).length ≤ 65533 := h + show (be16 (printAlpnNames ns).length ++ + printAlpnNames ns).length ≤ 65535 + rw [List.length_append] + simp [be16] + omega + · have h' : vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ + vs.length ≤ 127 := h + show ((printPairs vs).length.toUInt8 :: + printPairs vs).length ≤ 65535 + rw [List.length_cons, printPairs_length] + omega + · have h' : ss ≠ [] ∧ + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) ∧ + (printShares ss).length ≤ 65533 := h + show (be16 (printShares ss).length ++ + printShares ss).length ≤ 65535 + rw [List.length_append] + simp [be16] + omega + · have h' : ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ + t < 65536 ∧ v.length ≤ 65535 := h + exact h'.2.2 + +/-- A printed extension value reads back as the extension, + at its own type. -/ +theorem parseExtValue_printExtValue (e : Extension) + (h : ExtWF e) : + parseExtValue (extType e) (printExtValue e) = some e := by + rcases e with ⟨es⟩ | ⟨ns⟩ | ⟨vs⟩ | ⟨ss⟩ | ⟨t, v⟩ + · + have h' : es ≠ [] ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ + (e.1 = 0 → e.2 ≠ [])) ∧ + List.Nodup (es.map Prod.fst) ∧ + (printNameEntries es).length ≤ 65533 := h + show parseExtValue 0 (printExtValue + (Extension.serverName es)) = some (Extension.serverName es) + unfold parseExtValue + rw [if_pos rfl] + exact parseSNI_print h'.1 h'.2.1 h'.2.2.1 h'.2.2.2 + · have h' : ns ≠ [] ∧ + (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ + (printAlpnNames ns).length ≤ 65533 := h + show parseExtValue 16 (printExtValue + (Extension.alpn ns)) = some (Extension.alpn ns) + unfold parseExtValue + rw [if_neg (by decide), if_pos rfl] + exact parseALPN_print h'.1 h'.2.1 h'.2.2 + · have h' : vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ + vs.length ≤ 127 := h + show parseExtValue 43 (printExtValue + (Extension.supportedVersions vs)) + = some (Extension.supportedVersions vs) + unfold parseExtValue + rw [if_neg (by decide), if_neg (by decide), if_pos rfl] + exact parseSV_print h'.1 h'.2.1 h'.2.2 + · have h' : ss ≠ [] ∧ + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) ∧ + (printShares ss).length ≤ 65533 := h + show parseExtValue 51 (printExtValue + (Extension.keyShare ss)) = some (Extension.keyShare ss) + unfold parseExtValue + rw [if_neg (by decide), if_neg (by decide), + if_neg (by decide), if_pos rfl] + exact parseKS_print h'.1 h'.2.1 h'.2.2.1 h'.2.2.2 + · have h' : ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ + t < 65536 ∧ v.length ≤ 65535 := h + have hn := not_or.mp h'.1 + have hn2 := not_or.mp hn.2 + have hn3 := not_or.mp hn2.2 + show parseExtValue t (printExtValue + (Extension.opaque t v)) = some (Extension.opaque t v) + unfold parseExtValue + rw [if_neg hn.1, if_neg hn2.1, if_neg hn3.1, + if_neg hn3.2] + rfl + +/-- An extension value a successful read gives is the + printed form of the extension it gives, the extension + carries the type it was read under, and the extension + is well formed. -/ +theorem parseExtValue_inv {t : Nat} {v : List UInt8} + {e : Extension} + (ht : t < 65536) (hv : v.length ≤ 65535) + (h : parseExtValue t v = some e) : + extType e = t ∧ printExtValue e = v ∧ ExtWF e := by + unfold parseExtValue at h + by_cases h0 : t = 0 + · rw [if_pos h0] at h + obtain ⟨es, he, hprint, hwf⟩ := parseSNI_inv hv h + refine ⟨?_, ?_, ?_⟩ + · rw [he]; exact h0.symm + · rw [he]; exact hprint + · rw [he]; exact hwf + · rw [if_neg h0] at h + by_cases h16 : t = 16 + · rw [if_pos h16] at h + obtain ⟨ns, he, hprint, hwf⟩ := parseALPN_inv hv h + refine ⟨?_, ?_, ?_⟩ + · rw [he]; exact h16.symm + · rw [he]; exact hprint + · rw [he]; exact hwf + · rw [if_neg h16] at h + by_cases h43 : t = 43 + · rw [if_pos h43] at h + obtain ⟨vs, he, hprint, hwf⟩ := parseSV_inv h + refine ⟨?_, ?_, ?_⟩ + · rw [he]; exact h43.symm + · rw [he]; exact hprint + · rw [he]; exact hwf + · rw [if_neg h43] at h + by_cases h51 : t = 51 + · rw [if_pos h51] at h + obtain ⟨ss, he, hprint, hwf⟩ := parseKS_inv hv h + refine ⟨?_, ?_, ?_⟩ + · rw [he]; exact h51.symm + · rw [he]; exact hprint + · rw [he]; exact hwf + · rw [if_neg h51] at h + simp only [Option.some.injEq] at h + subst h + refine ⟨rfl, rfl, ?_⟩ + exact ⟨fun hc => by + rcases hc with rfl | rfl | rfl | rfl + · exact h0 rfl + · exact h16 rfl + · exact h43 rfl + · exact h51 rfl, ht, hv⟩ + +/-! ## The extensions block -/ + +/-- The printed length of one extension: four bytes of type + and length, then the value. -/ +theorem printExt_length (e : Extension) : + (printExt e).length = (printExtValue e).length + 4 := by + show (be16 (extType e) ++ be16 (printExtValue e).length ++ + printExtValue e).length = _ + rw [List.length_append, List.length_append] + have h1 : (be16 (extType e)).length = 2 := rfl + have h2 : (be16 (printExtValue e).length).length = 2 := rfl + omega + +/-- One step of the extension reader, stated for + rewriting. -/ +theorem parseExtsGo_step (f : Nat) (x y : UInt8) + (rest : List UInt8) : + parseExtsGo (f + 1) (x :: y :: rest) = + getU16 (x :: y :: rest) >>= fun (t, r1) => + getU16 r1 >>= fun (n, r2) => + if (r2.take n).length = n then + parseExtValue t (r2.take n) >>= fun e => + parseExtsGo f (r2.drop n) >>= fun es => + if extType e ∈ es.map extType then none + else some (e :: es) + else none := rfl + +/-- Printed extensions read back as the extensions. -/ +theorem parseExtsGo_print : + ∀ (es : List Extension) (fuel : Nat), + (∀ e ∈ es, ExtWF e) → + List.Nodup (es.map extType) → + (printExts es).length < fuel → + parseExtsGo fuel (printExts es) = some es := by + intro es + induction es with + | nil => + intro fuel _ _ hf + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + rfl + | cons e es ih => + intro fuel hw hnodup hf + have hwe : ExtWF e := hw e (by simp) + have htail : ∀ x ∈ es, ExtWF x := + fun x hx => hw x (List.mem_cons_of_mem e hx) + have hnodup' : List.Nodup (es.map extType) := by + have h2 : (e :: es).map extType + = extType e :: es.map extType := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).2 + have hnotin : extType e ∉ es.map extType := by + have h2 : (e :: es).map extType + = extType e :: es.map extType := rfl + rw [h2] at hnodup + exact (List.nodup_cons.mp hnodup).1 + obtain ⟨f, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + have hf' : (printExts es).length < f := by + have hflen : (printExts (e :: es)).length + = (printExt e).length + (printExts es).length := by + show ((printExt e) ++ printExts es).length = _ + rw [List.length_append] + have h2 := printExt_length e + omega + show parseExtsGo (f + 1) + ((be16 (extType e) ++ + (be16 (printExtValue e).length ++ + printExtValue e)) ++ printExts es) + = some (e :: es) + have hform : (be16 (extType e) ++ + (be16 (printExtValue e).length ++ + printExtValue e)) ++ printExts es + = (extType e / 256).toUInt8 :: (extType e).toUInt8 :: + ((printExtValue e).length / 256).toUInt8 :: + (printExtValue e).length.toUInt8 :: + (printExtValue e ++ printExts es) := by + simp only [be16, ← List.append_assoc, List.cons_append, + List.nil_append] + rw [hform, parseExtsGo_step] + have hg : getU16 ((extType e / 256).toUInt8 :: + (extType e).toUInt8 :: + ((printExtValue e).length / 256).toUInt8 :: + (printExtValue e).length.toUInt8 :: + (printExtValue e ++ printExts es)) + = some (extType e, + ((printExtValue e).length / 256).toUInt8 :: + (printExtValue e).length.toUInt8 :: + (printExtValue e ++ printExts es)) := by + show some (u16 (extType e / 256).toUInt8 + (extType e).toUInt8, _) = _ + rw [u16_be16 _ (extType_lt hwe)] + rw [hg] + simp only [Option.bind_some] + show (getU16 (((printExtValue e).length / 256).toUInt8 :: + (printExtValue e).length.toUInt8 :: + (printExtValue e ++ printExts es)) >>= + fun (n, r2) => + if (r2.take n).length = n then + parseExtValue (extType e) (r2.take n) >>= fun e' => + parseExtsGo f (r2.drop n) >>= fun es' => + if extType e' ∈ es'.map extType then none + else some (e' :: es') + else none) = some (e :: es) + have hk : getU16 (((printExtValue e).length / 256).toUInt8 :: + (printExtValue e).length.toUInt8 :: + (printExtValue e ++ printExts es)) + = some ((printExtValue e).length, + printExtValue e ++ printExts es) := by + show some (u16 ((printExtValue e).length / 256).toUInt8 + (printExtValue e).length.toUInt8, _) = _ + rw [u16_be16 _ (by + have h2 := printExtValue_length_le hwe + omega)] + rw [hk] + simp only [Option.bind_some] + show (if ((printExtValue e ++ printExts es).take + (printExtValue e).length).length + = (printExtValue e).length then + parseExtValue (extType e) + ((printExtValue e ++ printExts es).take + (printExtValue e).length) >>= fun e' => + parseExtsGo f ((printExtValue e ++ printExts es).drop + (printExtValue e).length) >>= fun es' => + if extType e' ∈ es'.map extType then none + else some (e' :: es') + else none) = some (e :: es) + rw [List.take_left, List.drop_left, if_pos rfl, + parseExtValue_printExtValue e hwe] + show (parseExtsGo f (printExts es) >>= fun es' => + if extType e ∈ es'.map extType then none + else some (e :: es')) = some (e :: es) + rw [ih f htail hnodup' hf'] + show (if extType e ∈ es.map extType then none + else some (e :: es)) = some (e :: es) + rw [if_neg hnotin] + +/-- Printed extensions read back, at the top level. -/ +theorem parseExts_print {es : List Extension} + (hw : ∀ e ∈ es, ExtWF e) + (hn : List.Nodup (es.map extType)) : + parseExts (printExts es) = some es := by + show parseExtsGo ((printExts es).length + 1) + (printExts es) = some es + exact parseExtsGo_print es _ hw hn (Nat.lt_succ_self _) + +/-- Extensions a successful read gives print back to the + bytes they were read from, each extension is well + formed, and no type stands twice. -/ +theorem parseExtsGo_inv : + ∀ (f : Nat) (bs : List UInt8) (es : List Extension), + parseExtsGo f bs = some es → + printExts es = bs ∧ + (∀ e ∈ es, ExtWF e) ∧ + List.Nodup (es.map extType) := by + intro f + induction f with + | zero => + intro bs es h + simp [parseExtsGo] at h + | succ f ih => + intro bs es h + cases bs with + | nil => + have h1 : parseExtsGo (f + 1) ([] : List UInt8) + = some [] := rfl + rw [h1] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨rfl, by simp, by simp⟩ + | cons b1 rest => + cases rest with + | nil => + have h1 : parseExtsGo (f + 1) [b1] = none := rfl + rw [h1] at h + simp at h + | cons b2 rest => + rw [parseExtsGo_step] at h + obtain ⟨⟨t, r1⟩, ht, h⟩ := Option.bind_eq_some_iff.mp h + change (getU16 r1 >>= fun (n, r2) => + if (r2.take n).length = n then + parseExtValue t (r2.take n) >>= fun e => + parseExtsGo f (r2.drop n) >>= fun es => + if extType e ∈ es.map extType then none + else some (e :: es) + else none) = some es at h + obtain ⟨⟨n, r2⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h + change (if (r2.take n).length = n then + parseExtValue t (r2.take n) >>= fun e => + parseExtsGo f (r2.drop n) >>= fun es' => + if extType e ∈ es'.map extType then none + else some (e :: es') + else none) = some es at h + obtain ⟨hbs, htlt⟩ := getU16_inv ht + obtain ⟨hr1, hnlt⟩ := getU16_inv hn + by_cases hc : (r2.take n).length = n + · rw [if_pos hc] at h + obtain ⟨e, hev, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨es', hrec, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec + obtain ⟨htype, hvalue, hwe⟩ := parseExtValue_inv htlt + (by rw [hc]; omega) hev + by_cases hd : extType e ∈ es'.map extType + · rw [if_pos hd] at h + simp at h + · rw [if_neg hd] at h + simp only [Option.some.injEq] at h + subst h + refine ⟨?_, ?_, ?_⟩ + · show printExts (e :: es') = b1 :: b2 :: rest + have htake : (r2.take n).length = n := hc + show (printExt e ++ printExts es') + = b1 :: b2 :: rest + show ((be16 (extType e) ++ + be16 (printExtValue e).length ++ + printExtValue e) ++ printExts es') + = b1 :: b2 :: rest + rw [htype, hvalue, htake, hprint, hbs, hr1] + simp only [List.append_assoc] + rw [List.take_append_drop] + · intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact hwe + · exact hprops x hx + · have h2 : (e :: es').map extType + = extType e :: es'.map extType := rfl + rw [h2] + exact List.nodup_cons.mpr ⟨hd, hnodup⟩ + · rw [if_neg hc] at h + simp at h + +/-- Extensions a successful read gives print back, at the + top level. -/ +theorem parseExts_inv {bs : List UInt8} + {es : List Extension} + (h : parseExts bs = some es) : + printExts es = bs ∧ + (∀ e ∈ es, ExtWF e) ∧ + List.Nodup (es.map extType) := + parseExtsGo_inv _ _ _ h + +/-- The value a successful one byte read gives fits in a + byte. -/ +theorem getU8_lt {bs : List UInt8} {n : Nat} {r : List UInt8} + (h : getU8 bs = some (n, r)) : n < 256 := by + cases bs with + | nil => simp [getU8] at h + | cons b r' => + have hstep : getU8 (b :: r') = some (b.toNat, r') := rfl + rw [hstep] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact toNat_lt b + +/-- A block read at exactly its own length gives the block + and nothing after it. -/ +theorem getBytes_self (bs : List UInt8) : + getBytes bs.length bs = some (bs, []) := by + unfold getBytes + have ht : bs.take bs.length = bs := List.take_length + have hd : bs.drop bs.length = [] := List.drop_length + rw [ht, hd, if_pos rfl] + +/-! ## The body fields -/ + +/-- The printed body fields read back as the hello. -/ +theorem parseBodyFields_print (m : Message) (hw : WF m) : + parseBodyFields (printBodyFields m.hello) = some m.hello := by + obtain ⟨_, hver, hrand, hsess, hsuites_ne, hsuites_lt, + hsuites_len, hcomp_ne, hcomp0, hcomp_len, hext_wf, + hnodup, hext_len, _⟩ := hw + have hsuites_len1 : 1 ≤ m.hello.cipherSuites.length := by + cases hcs : m.hello.cipherSuites with + | nil => exact absurd hcs hsuites_ne + | cons v vs' => simp + have hcomp_len1 : 1 ≤ m.hello.compressionMethods.length := by + cases hcc : m.hello.compressionMethods with + | nil => exact absurd hcc hcomp_ne + | cons c cs' => simp + have hsb : (m.hello.sessionId.length.toUInt8).toNat + = m.hello.sessionId.length := by + rw [toUInt8_toNat] + exact Nat.mod_eq_of_lt (by omega) + have hcb : (m.hello.compressionMethods.length.toUInt8).toNat + = m.hello.compressionMethods.length := by + rw [toUInt8_toNat] + exact Nat.mod_eq_of_lt (by omega) + have hguard : (printPairs m.hello.cipherSuites).length % 2 = 0 ∧ + 2 ≤ (printPairs m.hello.cipherSuites).length := by + have h2 := printPairs_length m.hello.cipherSuites + exact ⟨by omega, by omega⟩ + unfold parseBodyFields printBodyFields + simp only [List.append_assoc] + rw [getU16_be16 _ hver] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getBytes_app hrand] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [List.cons_append, getU8_cons] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [hsb, if_pos hsess, getBytes_app rfl] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getU16_be16 _ (by + have h2 := printPairs_length m.hello.cipherSuites + omega)] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos hguard, getBytes_app rfl] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [parsePairs_printPairs hsuites_lt] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [List.cons_append, getU8_cons] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [hcb, if_pos hcomp_len1, getBytes_app rfl] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos hcomp0, + getU16_be16 _ (by omega)] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getBytes_self] + simp only [Option.bind_eq_bind, Option.bind_some] + show (parseExts (printExts m.hello.extensions) >>= fun exts => + some ⟨m.hello.legacyVersion, m.hello.random, + m.hello.sessionId, m.hello.cipherSuites, + m.hello.compressionMethods, exts⟩) = some m.hello + rw [parseExts_print hext_wf hnodup] + simp only [Option.bind_eq_bind, Option.bind_some] + + + +/-- A parsed hello prints back to the input bytes, and every + field satisfies the well formedness bounds. -/ +theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} + (hparse : parseBodyFields bs = some h) : + printBodyFields h = bs ∧ + h.legacyVersion < 65536 ∧ h.random.length = 32 ∧ + h.sessionId.length ≤ 32 ∧ + h.cipherSuites ≠ [] ∧ + (∀ v ∈ h.cipherSuites, v < 65536) ∧ + h.cipherSuites.length ≤ 32767 ∧ + h.compressionMethods ≠ [] ∧ + (0 : UInt8) ∈ h.compressionMethods ∧ + h.compressionMethods.length ≤ 255 ∧ + (∀ e ∈ h.extensions, ExtWF e) ∧ + List.Nodup (h.extensions.map extType) ∧ + (printExts h.extensions).length ≤ 65535 := by + unfold parseBodyFields at hparse + simp only [Option.bind_eq_bind] at hparse + obtain ⟨⟨ver, r1⟩, s1, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨rand, r2⟩, s2, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨slen, r3⟩, s3, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hs : slen ≤ 32 + · rw [if_pos hs] at hparse + obtain ⟨⟨sess, r4⟩, s4, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨clen, r5⟩, s5, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hg : clen % 2 = 0 ∧ 2 ≤ clen + · rw [if_pos hg] at hparse + obtain ⟨⟨cbytes, r6⟩, s6, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨suites, s7, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨mlen, r7⟩, s8, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hm : 1 ≤ mlen + · rw [if_pos hm] at hparse + obtain ⟨⟨comps, r8⟩, s9, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases h0 : (0 : UInt8) ∈ comps + · rw [if_pos h0] at hparse + obtain ⟨⟨elen, r9⟩, s10, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨ebytes, r10⟩, s11, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hr : r10 = [] + · rw [if_pos hr] at hparse + obtain ⟨exts, s12, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + rw [Option.some.injEq] at hparse + subst hparse + have hbs : bs = be16 ver ++ r1 := + (getU16_inv s1).1 + have hver : ver < 65536 := (getU16_inv s1).2 + have hrand : rand.length = 32 := + (getBytes_inv s2).1 + have hr1 : r1 = rand ++ r2 := + (getBytes_inv s2).2 + have hr2 : r2 = slen.toUInt8 :: r3 := + getU8_inv s3 + have hsesslen : sess.length = slen := + (getBytes_inv s4).1 + have hr3 : r3 = sess ++ r4 := + (getBytes_inv s4).2 + have hr4 : r4 = be16 clen ++ r5 := + (getU16_inv s5).1 + have hclen_lt : clen < 65536 := + (getU16_inv s5).2 + have hcbyteslen : cbytes.length = clen := + (getBytes_inv s6).1 + have hr5 : r5 = cbytes ++ r6 := + (getBytes_inv s6).2 + have hpp : printPairs suites = cbytes := + (parsePairs_inv s7).1 + have hsuites_lt : ∀ v ∈ suites, v < 65536 := + (parsePairs_inv s7).2 + have hplen : cbytes.length + = 2 * suites.length := + parsePairs_length s7 + have hr6 : r6 = mlen.toUInt8 :: r7 := + getU8_inv s8 + have hmlen_lt : mlen < 256 := getU8_lt s8 + have hcomplen : comps.length = mlen := + (getBytes_inv s9).1 + have hr7 : r7 = comps ++ r8 := + (getBytes_inv s9).2 + have hr8 : r8 = be16 elen ++ r9 := + (getU16_inv s10).1 + have helen_lt : elen < 65536 := + (getU16_inv s10).2 + have hebyteslen : ebytes.length = elen := + (getBytes_inv s11).1 + have hr9 : r9 = ebytes ++ r10 := + (getBytes_inv s11).2 + have hpe : printExts exts = ebytes := + (parseExts_inv s12).1 + have hext_wf : ∀ e ∈ exts, ExtWF e := + (parseExts_inv s12).2.1 + have hnodup : (exts.map extType).Nodup := + (parseExts_inv s12).2.2 + have hsess_le : sess.length ≤ 32 := by omega + have hsuites_ne : suites ≠ [] := by + intro hcon + rw [hcon] at hplen + simp at hplen + have hz : cbytes.length = 0 := by + simp [hplen] + omega + have hsuites_len : suites.length ≤ 32767 := by + omega + have hcomp_ne : comps ≠ [] := by + intro hcon + rw [hcon] at hcomplen + simp at hcomplen + omega + have hcomp_len : comps.length ≤ 255 := by + omega + have hext_len : (printExts exts).length + ≤ 65535 := by + rw [hpe, hebyteslen] + omega + have hprint : printBodyFields + ⟨ver, rand, sess, suites, comps, exts⟩ + = bs := by + show (be16 ver ++ rand ++ + (sess.length.toUInt8 :: sess) ++ + (be16 (printPairs suites).length ++ + printPairs suites) ++ + (comps.length.toUInt8 :: comps) ++ + (be16 (printExts exts).length ++ + printExts exts)) = bs + rw [hsesslen, hcomplen, hpp, hcbyteslen, + hpe, hebyteslen, hbs, hr1, hr2, hr3, hr4, + hr5, hr6, hr7, hr8, hr9, hr] + simp only [List.append_assoc, List.cons_append, + List.append_nil] + exact ⟨hprint, hver, hrand, hsess_le, + hsuites_ne, hsuites_lt, hsuites_len, hcomp_ne, + h0, hcomp_len, hext_wf, hnodup, hext_len⟩ + · rw [if_neg hr] at hparse + simp at hparse + · rw [if_neg h0] at hparse + simp at hparse + · rw [if_neg hm] at hparse + simp at hparse + · rw [if_neg hg] at hparse + simp at hparse + · rw [if_neg hs] at hparse + simp at hparse + +/-! ## The handshake message and the record -/ + +/-- The printed handshake message is four bytes longer than + the printed body fields. -/ +theorem printBody_length (h : Hello) : + (printBody h).length = (printBodyFields h).length + 4 := by + simp [printBody, be24] + +/-- The printed handshake message reads back as the hello. -/ +theorem parseBody_print (m : Message) (hw : WF m) : + parseBody (printBody m.hello) = some m.hello := by + have hwf : WF m := hw + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, + hflen⟩ := hw + unfold parseBody printBody + rw [getU8_cons] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos (by decide : ((1 : UInt8).toNat = 1)), + getU24_be24 _ (by omega)] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getBytes_self] + simp only [Option.bind_eq_bind, Option.bind_some] + exact parseBodyFields_print m hwf + +/-- A parsed handshake message prints back to the input + bytes, and every field satisfies the bounds. -/ +theorem parseBody_inv {body : List UInt8} {h : Hello} + (hparse : parseBody body = some h) : + printBody h = body ∧ + h.legacyVersion < 65536 ∧ h.random.length = 32 ∧ + h.sessionId.length ≤ 32 ∧ + h.cipherSuites ≠ [] ∧ + (∀ v ∈ h.cipherSuites, v < 65536) ∧ + h.cipherSuites.length ≤ 32767 ∧ + h.compressionMethods ≠ [] ∧ + (0 : UInt8) ∈ h.compressionMethods ∧ + h.compressionMethods.length ≤ 255 ∧ + (∀ e ∈ h.extensions, ExtWF e) ∧ + List.Nodup (h.extensions.map extType) ∧ + (printExts h.extensions).length ≤ 65535 := by + unfold parseBody at hparse + simp only [Option.bind_eq_bind] at hparse + obtain ⟨⟨htype, r1⟩, s1, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases ht : htype = 1 + · rw [if_pos ht] at hparse + obtain ⟨⟨hlen, r2⟩, s2, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨fbs, r3⟩, s3, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hr : r3 = [] + · rw [if_pos hr] at hparse + have hfi := parseBodyFields_inv hparse + have hbody1 : body = htype.toUInt8 :: r1 := + getU8_inv s1 + have hbyte : htype.toUInt8 = (1 : UInt8) := by + rw [ht] + decide + have hr1 : r1 = be24 hlen ++ r2 := + (getU24_inv s2).1 + have hfbs : fbs.length = hlen := + (getBytes_inv s3).1 + have hr2 : r2 = fbs ++ r3 := (getBytes_inv s3).2 + have hprint : printBody h = body := by + show ((1 : UInt8) :: (be24 (printBodyFields h).length + ++ printBodyFields h)) = body + rw [hfi.1, hfbs, hbody1, hbyte, hr1, hr2, hr] + simp only [List.append_nil] + exact ⟨hprint, hfi.2⟩ + · rw [if_neg hr] at hparse + simp at hparse + · rw [if_neg ht] at hparse + simp at hparse + +/-- The whole printed message reads back as the message. -/ +theorem parse_print (m : Message) (hw : WF m) : + parse (print m) = some m := by + have hwf : WF m := hw + obtain ⟨hrv, _, _, _, _, _, _, _, _, _, _, _, _, + hflen⟩ := hw + have hblt : (printBody m.hello).length < 65536 := by + rw [printBody_length] + omega + unfold parse print + rw [getU8_cons] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [if_pos (by decide : ((22 : UInt8).toNat = 22)), + getU16_be16 _ hrv] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getU16_be16 _ hblt] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [getBytes_self] + simp only [Option.bind_eq_bind, Option.bind_some] + show (Option.map (fun h => ⟨m.recordVersion, h⟩) + (parseBody (printBody m.hello))) = some m + rw [parseBody_print m hwf] + simp only [Option.map_some] + +/-- A parsed message prints back to the input bytes, and the + message is well formed. -/ +theorem print_parse {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) : + print m = bs ∧ WF m := by + unfold parse at hparse + simp only [Option.bind_eq_bind] at hparse + obtain ⟨⟨ct, r1⟩, s1, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hct : ct = 22 + · rw [if_pos hct] at hparse + obtain ⟨⟨rv, r2⟩, s2, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨rlen, r3⟩, s3, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + obtain ⟨⟨body, r4⟩, s4, hparse⟩ := + Option.bind_eq_some_iff.mp hparse + by_cases hr : r4 = [] + · rw [if_pos hr] at hparse + cases hpb : parseBody body with + | none => + rw [hpb] at hparse + simp at hparse + | some hh => + rw [hpb] at hparse + simp only [Option.map_some, Option.some.injEq] + at hparse + subst hparse + obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, + hslen, hcne, hc0, hclen, hewf, hnod, helen⟩ := + parseBody_inv hpb + have hbs1 : bs = ct.toUInt8 :: r1 := getU8_inv s1 + have hctb : ct.toUInt8 = (22 : UInt8) := by + rw [hct] + decide + have hr1 : r1 = be16 rv ++ r2 := + (getU16_inv s2).1 + have hrv : rv < 65536 := (getU16_inv s2).2 + have hr2 : r2 = be16 rlen ++ r3 := + (getU16_inv s3).1 + have hrlen : rlen < 65536 := (getU16_inv s3).2 + have hbodylen : body.length = rlen := + (getBytes_inv s4).1 + have hr3 : r3 = body ++ r4 := + (getBytes_inv s4).2 + have hflen : (printBodyFields hh).length + ≤ 65531 := by + have h1 := printBody_length hh + rw [hbody_eq] at h1 + omega + have hprint : print ⟨rv, hh⟩ = bs := by + show ((22 : UInt8) :: (be16 rv ++ + (be16 (printBody hh).length ++ printBody hh))) + = bs + rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, + hr3, hr] + simp only [List.append_nil] + exact ⟨hprint, hrv, hver, hrand, hsess, hsne, + hslt, hslen, hcne, hc0, hclen, hewf, hnod, helen, + hflen⟩ + · rw [if_neg hr] at hparse + simp at hparse + · rw [if_neg hct] at hparse + simp at hparse diff --git a/Proofs/Verify.lean b/Proofs/Verify.lean new file mode 100644 index 0000000..ab094b5 --- /dev/null +++ b/Proofs/Verify.lean @@ -0,0 +1,4 @@ +import Proofs.RoundTrip + +#print axioms ClientHello.Proofs.parse_print +#print axioms ClientHello.Proofs.print_parse diff --git a/README.md b/README.md index 5d9891b..be6ebff 100644 --- a/README.md +++ b/README.md @@ -1,38 +1,111 @@ -# clienthello +# clienthello: a TLS ClientHello parser and printer, with proved round trips -A Lean parser for the TLS ClientHello message. This is a Proven Commons project: it rebuilds a widely used format in Lean and proves the new code follows its written specification. +A parser and printer for the TLS ClientHello message, in +Lean, following RFC 8446 section 4.1.2, with the legacy +fields carried from RFC 5246, the server name indication +from RFC 6066, and ALPN from RFC 7301. The definitions are +in `ClientHello/Value.lean` (the data model and the +printer) and `ClientHello/Parse.lean` (the parser). The +proofs are in `Proofs/RoundTrip.lean`. The rules are +written out in `SPEC.md`. This slice reads one TLS record +holding one ClientHello; it does no handshake crypto and +parses no certificates. -Status: not verified. No code has landed yet. Plan issue 1 holds the first slice, and it is unclaimed. The specification has not been approved by a reviewer, so do not call this verified. +Status: the specification has not been approved by a +reviewer, so do not call this verified. The statements a +reviewer approves (the bar's `Spec.lean`) have not been +added yet. -## First slice +## How to run it -- The TLS record header plus the ClientHello, from RFC 8446 section 4.1.2, with legacy fields from RFC 5246. -- Version, random, session id, cipher suites, and compression methods. -- Extensions as a type length value list. Four are decoded: server name indication, application layer protocol negotiation, supported versions, and key share. -- Other extensions are carried as opaque bytes with length checks, not interpreted. +`lake build` builds the library, the proofs, and the +command line tool. The tool reads one request per line: +the word `parse`, a space, and the message as +comma-separated decimal byte codes. It answers `ok:` and +the byte codes of the canonical reprint when the message +parses, `none` when it is rejected, and `error` when the +request itself is malformed. -This is distinct from the hostname repo. ClientHello extracts the server name string. Matching that name against a certificate stays in the hostname repo. +`python3 tests/run_tests.py` rebuilds, runs the fixed +cases, the named rejections, and the differential run +against the harness oracle, and writes the outcome to +`tests/TEST-RESULTS.md`. -## Main claim +## What is proved -The parser never reads past the end of the message. A duplicate extension type is rejected. A duplicate key share group is rejected. An extension length that runs past the message is rejected. Printing the parsed form gives the same bytes for the parsed subset. +| Claim | Theorem | +|-------|---------| +| Parsing the printed form of a well formed message gives the message back. | `ClientHello.Proofs.parse_print` | +| Printing a message the parser took gives the same bytes it was read from. | `ClientHello.Proofs.print_parse` | -## Test oracles +A message is well formed when the record version and the +legacy version each fit two bytes; the random holds +exactly 32 bytes; the session id holds at most 32 bytes; +the cipher suites are nonempty, each fits two bytes, and +there are at most 32767 of them; the compression methods +are nonempty, contain the null method 0, and number at +most 255; every extension is well formed (its lengths fit +their fields, SNI has distinct entry types and a nonempty +host name when present, ALPN names are nonempty, key +share groups are distinct with nonempty keys, and an +opaque extension's type is none of the four decoded +types); no extension type stands twice; the printed +extensions block fits two bytes of length; and the +printed body fields fit the three byte handshake length +with room to spare (at most 65531 bytes). -- Go crypto/tls. -- OpenSSL captures. -- Wireshark TLS dissectors. +Both theorems check against the standard axioms only +(`propext`, `Classical.choice`, `Quot.sound`), which a +reader can confirm with `#print axioms` on +`ClientHello.Proofs.parse_print` and +`ClientHello.Proofs.print_parse`; `Proofs/Verify.lean` +prints them at build time. -## Score +The command line tool in `Main.lean` calls these +functions directly. -15 out of 18, first pass score in mission issue 19, the round 4 sheet. Created at the org owner's direction on that sheet, on the judgement that the slice, claim, and oracles are sound and that it duplicates no existing repo. +## What is not proved -## What is not in this slice +- That the parser accepts every message the rules in + `SPEC.md` allow, and turns away every message they + forbid. The round trips do not need either, so neither + is proved. The differential tests in `tests/` check + that behaviour instead, and the results file records + the outcome, including any failure. +- The meaning of any extension other than the four + decoded ones. Every other extension is carried as its + type and value bytes, and no per extension content rule + is checked. +- Anything about the host name bytes beyond their being + nonempty when present: no label rules, no case rules, no + matching against a certificate. Name matching belongs + to the hostname work. +- Anything about the rest of the handshake, the key + schedule, or any other record or message type. -- The rest of the TLS handshake. -- Certificate parsing. That follows from the der repo. -- Any claim about a full TLS implementation. +## What you must trust -## Layout, when the first slice lands +- The Lean toolchain (Lean 4.35.0) and its kernel. +- That `SPEC.md` states the reading of the RFCs you + intend. The proofs are about the parser and printer in + this repo following each other exactly; the fidelity of + the spec to the RFCs is a reading, pinned in SPEC.md + where the RFCs leave a choice open. +- The test oracle in `tests/run_tests.py` is a second + reading of the same rules, in Python. It is evidence, + not proof. +- The line handling in `Main.lean` (splitting a request + line, reading decimal codes). The tests drive it, and + no proof covers it. -The layout follows the Proven Commons template in the mission repo, under bar/template. Spec.lean holds the statements a reviewer approves. Proofs.lean holds the proofs under the same names. Main.lean holds the command line tool used by the tests. The bar check runs in CI on every change. +## How to re-check it + +1. `lake build`: the library, the proofs, and the tool + build clean, and the build prints the axiom list for + both theorems. +2. `python3 tests/run_tests.py`: the fixed cases, the + named rejections, and the differential run against the + oracle, with counts and any failures written to + `tests/TEST-RESULTS.md`. +3. Read `SPEC.md` against RFC 8446 section 4.1.2 and + check the pinned readings are the ones you want. diff --git a/SPEC.md b/SPEC.md new file mode 100644 index 0000000..78ebecc --- /dev/null +++ b/SPEC.md @@ -0,0 +1,166 @@ +# Specification: clienthello + +A TLS ClientHello parser and printer in Lean, following +RFC 8446 section 4.1.2 (the ClientHello message), the +legacy fields as carried from RFC 5246, RFC 6066 section 3 +(the server name indication), and RFC 7301 (ALPN). This +slice reads exactly one TLS record holding exactly one +ClientHello, and prints that message back in canonical +form: every length is recomputed from the values. + +## The record layer + +A message is one TLS record: + +| Bytes | Field | +|-------|-------| +| 0 | content type: must be 22 (handshake) | +| 1, 2 | legacy record version: carried, value unchecked | +| 3, 4 | length: two bytes, big endian | +| 5 ... | the record body, exactly that many bytes | + +- Input shorter than the five byte header rejects. +- A body shorter than the declared length rejects. +- Bytes after the record reject. The decoder takes exactly + one record; a stream reader is later work. +- A record length of 0 rejects: an empty body cannot hold + a ClientHello. (In the code this falls out of the body + read failing; it is stated here because it is a rule a + reader of the bytes should expect.) + +## The handshake header + +Inside the record body: + +| Bytes | Field | +|-------|-------| +| 0 | message type: must be 1 (client_hello) | +| 1, 2, 3 | length: three bytes, big endian | +| 4 ... | the ClientHello body | + +The three byte length must equal the remaining body length +exactly. A mismatch rejects. + +## The ClientHello body + +In order: + +| Field | Size | Rule | +|-------|------|------| +| legacy version | 2 bytes | carried, value unchecked | +| random | 32 bytes | exactly 32 | +| legacy session id | 1 byte length, then that many bytes | length at most 32; a longer length rejects | +| cipher suites | 2 byte length, then that many bytes | length even and at least 2; the bytes read as two byte suite codes; an empty list or an odd length rejects | +| legacy compression methods | 1 byte length, then that many bytes | length at least 1; the list must contain the byte 0 (the null method) | +| extensions | 2 byte length, then that many bytes | the block must consume the rest of the body exactly | + +The extensions block must be present. A body that ends +after the compression methods is the pre-TLS-1.3 shape; +this slice rejects it, because the slice frames the +message by its extensions and supported_versions is how a +TLS 1.3 hello speaks. The block may be empty: a present +block of length 0 consumes the body and carries no +extensions, and is accepted. + +## Extensions + +Each extension is a two byte type, a two byte length, and +that many value bytes. An extension length running past +the end of the block rejects, and the block must be +consumed exactly. A duplicate extension type rejects. + +Four types are decoded. Every other type is carried as +the pair of its type and its raw value bytes, length +checked, not interpreted. + +### server_name (type 0), RFC 6066 section 3 + +The value is a two byte list length covering the rest of +the value, then entries. Each entry is a one byte name +type, a two byte length, and that many bytes. Type 0 is +host_name. + +- The list length must equal the value length minus two. +- The list must be nonempty and consume the value exactly. +- Two entries of the same type reject, so there is at + most one host_name entry. +- The host_name bytes must be nonempty. +- Host name bytes are carried as bytes. No case folding, + label, or character validation happens in this slice. + Entries of other types are carried as (type, bytes). + +### ALPN (type 16), RFC 7301 + +The value is a two byte list length covering the rest of +the value, then protocol names. Each name is a one byte +length and that many bytes. + +- The list length must equal the value length minus two. +- The list must be nonempty and consume the value exactly. +- A name length of 0 rejects. + +### supported_versions (type 43), RFC 8446 section 4.2.1 + +The client form: a one byte length, then that many bytes +read as two byte versions. + +- The length must equal the value length minus one. +- The length must be even and at least 2. An odd or zero + length rejects. + +The server form (a single version) is not this message and +is not read here. + +### key_share (type 51), RFC 8446 section 4.2.8 + +The client form: a two byte list length covering the rest +of the value, then entries. Each entry is a two byte +group, a two byte key exchange length, and that many +bytes. + +- The list length must equal the value length minus two. +- The list must be nonempty and consume the value exactly. +- A key exchange length of 0 rejects. +- A duplicate group rejects. + +## Pinned readings + +Where the RFCs or the plan leave a reading open, this +slice pins it: + +- Trailing bytes after the record reject. +- A missing extensions block rejects; a present block of + length 0 is accepted. +- Compression methods must contain the byte 0. +- The session id length is at most 32. +- The cipher suite list is nonempty, with an even byte + length. +- A duplicate extension type rejects. +- SNI carries at most one host_name entry, and duplicate + SNI entry types reject in general. +- Host name bytes are unvalidated beyond being nonempty. +- Unknown extension types are carried opaque. +- A duplicate key share group rejects. + +## Safety + +The parser never reads past the end of its input. Every +read goes through the length checked readers (getU8, +getU16, getU24, getBytes): a read either takes bytes that +are present, checked against the remaining length, or +fails. The extension parsers run over a value already cut +to its declared length, so the same check bounds them. +This is the reader model used across the sibling slices. + +## Slice boundaries + +- No server messages: no ServerHello, no EncryptedExtensions, + no Certificate, no Finished. +- No handshake crypto: no key schedule, no transcript hash, + no signature checking. +- No certificate work of any kind, and no matching of the + server name against a certificate. That matching belongs + to the hostname work; this slice only carries the name + bytes out of the message. +- One record only: no stream reading, no record splitting + or joining, no alerts, no renegotiation. diff --git a/lake-manifest.json b/lake-manifest.json new file mode 100644 index 0000000..e965eb3 --- /dev/null +++ b/lake-manifest.json @@ -0,0 +1,6 @@ +{"version": "1.3.0", + "packagesDir": ".lake/packages", + "packages": [], + "name": "clienthello", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000..0a3c41e --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,13 @@ +name = "clienthello" +version = "0.1.0" +defaultTargets = ["ClientHello", "Proofs", "clienthello"] + +[[lean_lib]] +name = "ClientHello" + +[[lean_lib]] +name = "Proofs" + +[[lean_exe]] +name = "clienthello" +root = "Main" diff --git a/lean-toolchain b/lean-toolchain new file mode 100644 index 0000000..a6aff06 --- /dev/null +++ b/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.35.0 diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md new file mode 100644 index 0000000..a647a11 --- /dev/null +++ b/tests/TEST-RESULTS.md @@ -0,0 +1,59 @@ +# ClientHello slice: test results + +Run: python3 tests/run_tests.py --seed 20261026 --count 3200 +Seed: 20261026. Python 3.12.3. + +## Oracles + +Every verdict is settled by the harness oracle, a Python implementation of the rules in SPEC.md written for these tests. The tool must agree with the oracle on every input, and an accepted message must reprint to the oracle's canonical reprint byte for byte. + +Python's ssl module cannot build a ClientHello on demand. Go is not installed (`go version` fails). Scapy 2.8.0 is present in the sibling dhcp project's venv and its TLS submodules import, but building or dissecting a TLS record raises NameError inside scapy's crypto support (HMAC is not defined), so Scapy could not be used as a byte source. No capture was fetched; the fixed cases are built by hand from the RFCs. + +## Counts + +| part | run | agreed | +| --- | --- | --- | +| named cases | 29 | 29 | +| generated messages | 3200 | 3200 | +| mutations of the full hello | 1308 | 1308 | +| random raw byte strings | 300 | 300 | +| malformed request lines | 7 | 7 | +| total | 4844 | 4844 | + +Of the 3200 generated messages, the oracle accepts 1125 and rejects 2075. + +## Named cases + +- full TLS 1.3 style hello: accept (252 bytes) +- minimal hello, supported versions only: accept (61 bytes) +- duplicate extension type: reject (66 bytes) +- duplicate key share group: reject (130 bytes) +- extension length overrunning the block: reject (59 bytes) +- record length longer than the input: reject (52 bytes) +- handshake length not matching the body: reject (52 bytes) +- content type 23: reject (61 bytes) +- handshake type 2: reject (61 bytes) +- session id length 33: reject (85 bytes) +- odd cipher suite length: reject (53 bytes) +- empty cipher suites: reject (50 bytes) +- compression methods without 0: reject (53 bytes) +- missing extensions block: reject (50 bytes) +- supported versions odd length: reject (60 bytes) +- supported versions length zero: reject (57 bytes) +- ALPN empty name: reject (59 bytes) +- ALPN list length mismatch: reject (61 bytes) +- ALPN empty list: reject (58 bytes) +- SNI second host_name entry: reject (82 bytes) +- SNI list length mismatch: reject (72 bytes) +- SNI empty list: reject (58 bytes) +- key share empty key bytes: reject (62 bytes) +- key share empty list: reject (58 bytes) +- trailing garbage after the record: reject (53 bytes) +- empty extensions block, length 0, accepted: accept (52 bytes) +- record length zero: reject (5 bytes) +- input shorter than the record header: reject (2 bytes) +- empty input: reject (0 bytes) + +## Differences + +No disagreements between the tool and the oracle, and every named case matched its stated expectation. diff --git a/tests/run_tests.py b/tests/run_tests.py new file mode 100644 index 0000000..24c8047 --- /dev/null +++ b/tests/run_tests.py @@ -0,0 +1,860 @@ +#!/usr/bin/env python3 +"""Tests for the Lean TLS ClientHello parser and printer. + +Three parts. + +1. Fixed cases built by hand from RFC 8446 section 4.1.2, + RFC 5246 and RFC 6066: one full TLS 1.3 style hello (SNI + for a named host, ALPN h2 and http/1.1, supported versions + 0x0304 and 0x0303, key shares for x25519 and secp256r1 + with fixed key bytes, and one opaque extension), one + minimal hello (supported versions only), and the named + rejection shapes listed in SPEC.md, plus the pinned + reading that a present but empty extensions block (length + 0) is accepted. + +2. A differential run against a strict Python oracle written + in this harness from the rules in SPEC.md: at least 3,000 + generated messages (varied record and legacy versions, + session ids, cipher suite lists, compression lists, + extension sets and orders, with defects injected from a + menu), plus raw mutations of the full fixed hello (every + truncation, single byte flips, random multi-byte changes) + and fully random byte strings. The oracle settles every + verdict; the tool must agree with it on each input. + +3. Malformed request lines must be answered `error`. + +Oracle availability, checked when this harness was written +and stated again in the results record: Python's ssl module +cannot build a ClientHello on demand. Go is not installed +(`go version` fails). Scapy 2.8.0 is importable from the +sibling dhcp project's venv and its TLS submodules import, +but building or dissecting a TLS record raises NameError +inside scapy's crypto support (HMAC is not defined), so +Scapy cannot serve as a byte source in this environment and +was not used. No captured ClientHello was fetched; the +fixed cases are built by hand from the RFCs. + + python3 tests/run_tests.py [--seed N] [--count N] + +The tool is driven one batch process per chunk of requests, +input written and closed, output drained until the process +exits. It builds the executable first, writes +tests/TEST-RESULTS.md, and exits non-zero if any check +fails. It needs Python 3.11 or later. +""" + +import argparse +import os +import platform +import random +import subprocess +import sys +import threading +from pathlib import Path + +ROOT = Path(__file__).resolve().parent.parent +EXE = ROOT / ".lake" / "build" / "bin" / "clienthello" +RESULTS = ROOT / "tests" / "TEST-RESULTS.md" + + +# ---------------------------------------------------------------- +# The oracle: an independent implementation of the SPEC rules. +# It parses bytes into a model and reprints the model; the +# reprint of an accepted message is the expected tool answer. +# ---------------------------------------------------------------- + +class Reject(Exception): + pass + + +def take(bs, i, n): + if i + n > len(bs): + raise Reject() + return bs[i:i + n], i + n + + +def u8(bs, i): + bs2, i = take(bs, i, 1) + return bs2[0], i + + +def u16(bs, i): + bs2, i = take(bs, i, 2) + return (bs2[0] << 8) | bs2[1], i + + +def u24(bs, i): + bs2, i = take(bs, i, 3) + return (bs2[0] << 16) | (bs2[1] << 8) | bs2[2], i + + +def be16(n): + return bytes([(n >> 8) & 0xFF, n & 0xFF]) + + +def be24(n): + return bytes([(n >> 16) & 0xFF, (n >> 8) & 0xFF, n & 0xFF]) + + +def oracle_sni(v): + listlen, i = u16(v, 0) + if listlen != len(v) - 2: + raise Reject() + entries = [] + seen = set() + while i < len(v): + t, i = u8(v, i) + ln, i = u16(v, i) + name, i = take(v, i, ln) + if t in seen: + raise Reject() + seen.add(t) + if t == 0 and len(name) == 0: + raise Reject() + entries.append((t, bytes(name))) + if not entries: + raise Reject() + out = be16(listlen) + for t, name in entries: + out += bytes([t]) + be16(len(name)) + name + return ("sni", entries), out + + +def oracle_alpn(v): + listlen, i = u16(v, 0) + if listlen != len(v) - 2: + raise Reject() + names = [] + while i < len(v): + ln, i = u8(v, i) + if ln < 1: + raise Reject() + name, i = take(v, i, ln) + names.append(bytes(name)) + if not names: + raise Reject() + out = be16(listlen) + for name in names: + out += bytes([len(name)]) + name + return ("alpn", names), out + + +def oracle_sv(v): + ln, i = u8(v, 0) + if ln != len(v) - 1 or ln % 2 != 0 or ln < 2: + raise Reject() + versions = [] + while i < len(v): + ver, i = u16(v, i) + versions.append(ver) + out = bytes([ln]) + for ver in versions: + out += be16(ver) + return ("sv", versions), out + + +def oracle_ks(v): + listlen, i = u16(v, 0) + if listlen != len(v) - 2: + raise Reject() + shares = [] + seen = set() + while i < len(v): + group, i = u16(v, i) + klen, i = u16(v, i) + if klen < 1: + raise Reject() + key, i = take(v, i, klen) + if group in seen: + raise Reject() + seen.add(group) + shares.append((group, bytes(key))) + if not shares: + raise Reject() + out = be16(listlen) + for group, key in shares: + out += be16(group) + be16(len(key)) + key + return ("ks", shares), out + + +def oracle_ext_value(t, v): + if t == 0: + return oracle_sni(v) + if t == 16: + return oracle_alpn(v) + if t == 43: + return oracle_sv(v) + if t == 51: + return oracle_ks(v) + return ("opaque", t, bytes(v)), bytes(v) + + +def oracle_exts(block): + exts = [] + seen = set() + i = 0 + while i < len(block): + t, i = u16(block, i) + ln, i = u16(block, i) + v, i = take(block, i, ln) + if t in seen: + raise Reject() + seen.add(t) + ext, _ = oracle_ext_value(t, bytes(v)) + exts.append((t, ext)) + return exts + + +def print_ext(ext): + kind = ext[0] + if kind == "sni": + body = b"" + for t, name in ext[1]: + body += bytes([t]) + be16(len(name)) + name + return be16(0) + be16(len(body) + 2) + be16(len(body)) + body + if kind == "alpn": + body = b"" + for name in ext[1]: + body += bytes([len(name)]) + name + return be16(16) + be16(len(body) + 2) + be16(len(body)) + body + if kind == "sv": + body = bytes([2 * len(ext[1])]) + for ver in ext[1]: + body += be16(ver) + return be16(43) + be16(len(body)) + body + if kind == "ks": + body = b"" + for group, key in ext[1]: + body += be16(group) + be16(len(key)) + key + return be16(51) + be16(len(body) + 2) + be16(len(body)) + body + _, t, v = ext + return be16(t) + be16(len(v)) + v + + +def oracle_parse(bs): + """The canonical reprint of the message, or None.""" + try: + return oracle_parse_go(bs) + except Reject: + return None + + +def oracle_parse_go(bs): + ct, i = u8(bs, 0) + if ct != 22: + raise Reject() + rv, i = take(bs, i, 2) + rlen, i = u16(bs, i) + body, i = take(bs, i, rlen) + if i != len(bs): + raise Reject() + htype, j = u8(body, 0) + if htype != 1: + raise Reject() + hlen, j = u24(body, j) + fields, j = take(body, j, hlen) + if j != len(body): + raise Reject() + ver, k = take(fields, 0, 2) + rand, k = take(fields, k, 32) + slen, k = u8(fields, k) + if slen > 32: + raise Reject() + sess, k = take(fields, k, slen) + clen, k = u16(fields, k) + if clen % 2 != 0 or clen < 2: + raise Reject() + cbytes, k = take(fields, k, clen) + suites = [] + for off in range(0, clen, 2): + suites.append((cbytes[off] << 8) | cbytes[off + 1]) + mlen, k = u8(fields, k) + if mlen < 1: + raise Reject() + comps, k = take(fields, k, mlen) + if 0 not in comps: + raise Reject() + elen, k = u16(fields, k) + block, k = take(fields, k, elen) + if k != len(fields): + raise Reject() + exts = oracle_exts(bytes(block)) + out_fields = bytes(ver) + bytes(rand) + out_fields += bytes([len(sess)]) + bytes(sess) + pairs = b"" + for s in suites: + pairs += be16(s) + out_fields += be16(len(pairs)) + pairs + out_fields += bytes([len(comps)]) + bytes(comps) + block_out = b"" + for _, ext in exts: + block_out += print_ext(ext) + out_fields += be16(len(block_out)) + block_out + out_body = bytes([1]) + be24(len(out_fields)) + out_fields + return bytes([22]) + bytes(rv) + be16(len(out_body)) + out_body + + +# ---------------------------------------------------------------- +# Builders: byte level construction of test messages, with +# knobs for the defect cases. The builders are not the oracle; +# every built message is judged by the oracle and the tool. +# ---------------------------------------------------------------- + +def sni_value(entries): + body = b"" + for t, name in entries: + body += bytes([t]) + be16(len(name)) + name + return be16(len(body)) + body + + +def alpn_value(names): + body = b"" + for name in names: + body += bytes([len(name)]) + name + return be16(len(body)) + body + + +def sv_value(versions): + body = bytes([2 * len(versions)]) + for ver in versions: + body += be16(ver) + return body + + +def ks_value(shares): + body = b"" + for group, key in shares: + body += be16(group) + be16(len(key)) + key + return be16(len(body)) + body + + +def ext_bytes(t, v): + return be16(t) + be16(len(v)) + v + + +def build_hello(record_version=b"\x03\x01", legacy_version=b"\x03\x03", + random_bytes=None, session_id=b"", suites=(0x1301,), + comps=(0,), exts=(), ext_block=True, + record_len_delta=0, hs_len_delta=0, trailing=b""): + if random_bytes is None: + random_bytes = bytes(range(32)) + fields = legacy_version + random_bytes + fields += bytes([len(session_id)]) + session_id + pairs = b"" + for s in suites: + pairs += be16(s) + fields += be16(len(pairs)) + pairs + fields += bytes([len(comps)]) + bytes(comps) + if ext_block: + block = b"" + for t, v in exts: + block += ext_bytes(t, v) + fields += be16(len(block)) + block + body = bytes([1]) + be24(len(fields) + hs_len_delta) + fields + rec = bytes([22]) + record_version + rec += be16(len(body) + record_len_delta) + body + return rec + trailing + + +FULL_EXTS = [ + (0, sni_value([(0, b"example.com")])), + (16, alpn_value([b"h2", b"http/1.1"])), + (43, sv_value([0x0304, 0x0303])), + (51, ks_value([(29, bytes(range(32))), + (23, b"\x04" + bytes(range(64)))])), + (23, b""), +] +FULL_HELLO = build_hello( + session_id=bytes(range(32)), + suites=(0x1301, 0x1302, 0x1303, 0xC02F), + exts=FULL_EXTS) +MIN_HELLO = build_hello(exts=[(43, sv_value([0x0304, 0x0303]))]) +EMPTY_EXT_HELLO = build_hello(exts=[]) + + +def raw_fields(suites_bytes, comps=(0,), exts=(), ext_block=True): + fields = b"\x03\x03" + bytes(range(32)) + b"\x00" + fields += be16(len(suites_bytes)) + suites_bytes + fields += bytes([len(comps)]) + bytes(comps) + if ext_block: + block = b"" + for t, v in exts: + block += ext_bytes(t, v) + fields += be16(len(block)) + block + body = bytes([1]) + be24(len(fields)) + fields + return bytes([22, 3, 1]) + be16(len(body)) + body + + +def named_cases(): + """(name, bytes, expected: True accept / False reject).""" + cases = [] + cases.append(("full TLS 1.3 style hello", FULL_HELLO, True)) + cases.append(("minimal hello, supported versions only", + MIN_HELLO, True)) + cases.append(("duplicate extension type", + build_hello(exts=[(43, sv_value([0x0304])), + (43, sv_value([0x0303]))]), + False)) + cases.append(("duplicate key share group", + build_hello(exts=[(51, ks_value( + [(29, b"\x01" * 32), (29, b"\x02" * 32)]))]), + False)) + overrun_block = be16(0) + be16(10) + b"\x02\x03\x04" + fields = b"\x03\x03" + bytes(range(32)) + b"\x00" + fields += be16(2) + b"\x13\x01" + b"\x01\x00" + fields += be16(len(overrun_block)) + overrun_block + body = bytes([1]) + be24(len(fields)) + fields + cases.append(("extension length overrunning the block", + bytes([22, 3, 1]) + be16(len(body)) + body, + False)) + cases.append(("record length longer than the input", + build_hello(record_len_delta=5), False)) + cases.append(("handshake length not matching the body", + build_hello(hs_len_delta=1), False)) + bad = bytearray(MIN_HELLO) + bad[0] = 23 + cases.append(("content type 23", bytes(bad), False)) + bad = bytearray(MIN_HELLO) + bad[5] = 2 + cases.append(("handshake type 2", bytes(bad), False)) + cases.append(("session id length 33", + build_hello(session_id=b"\x07" * 33), False)) + cases.append(("odd cipher suite length", + raw_fields(b"\x13\x01\x13"), False)) + cases.append(("empty cipher suites", + build_hello(suites=()), False)) + cases.append(("compression methods without 0", + build_hello(comps=(1, 2)), False)) + cases.append(("missing extensions block", + build_hello(ext_block=False), False)) + cases.append(("supported versions odd length", + build_hello(exts=[(43, bytes([3, 3, 4, 3]))]), + False)) + cases.append(("supported versions length zero", + build_hello(exts=[(43, bytes([0]))]), False)) + cases.append(("ALPN empty name", + build_hello(exts=[(16, be16(1) + b"\x00")]), + False)) + alpn_bad = be16(9) + alpn_value([b"h2"])[2:] + cases.append(("ALPN list length mismatch", + build_hello(exts=[(16, alpn_bad)]), False)) + cases.append(("ALPN empty list", + build_hello(exts=[(16, alpn_value([]))]), + False)) + cases.append(("SNI second host_name entry", + build_hello(exts=[(0, sni_value( + [(0, b"a.example"), (0, b"b.example")]))]), + False)) + sni_bad = be16(99) + sni_value([(0, b"example.com")])[2:] + cases.append(("SNI list length mismatch", + build_hello(exts=[(0, sni_bad)]), False)) + cases.append(("SNI empty list", + build_hello(exts=[(0, sni_value([]))]), + False)) + cases.append(("key share empty key bytes", + build_hello(exts=[(51, ks_value([(29, b"")]))]), + False)) + cases.append(("key share empty list", + build_hello(exts=[(51, ks_value([]))]), + False)) + cases.append(("trailing garbage after the record", + build_hello(trailing=b"\x00"), False)) + cases.append(("empty extensions block, length 0, accepted", + EMPTY_EXT_HELLO, True)) + cases.append(("record length zero", + bytes([22, 3, 1, 0, 0]), False)) + cases.append(("input shorter than the record header", + bytes([22, 3]), False)) + cases.append(("empty input", b"", False)) + return cases + + +# ---------------------------------------------------------------- +# The generated differential cases. +# ---------------------------------------------------------------- + +HOSTS = [b"example.com", b"a.b.example.org", b"x", b"host-name.example"] + + +def gen_sni(rng, defect): + entries = [(0, rng.choice(HOSTS))] + if rng.random() < 0.3: + entries.append((rng.choice([1, 2, 3, 17]), + bytes(rng.randrange(256) + for _ in range(rng.randrange(1, 6))))) + if defect == "sni-second-host": + entries.append((0, b"other.example")) + if defect == "sni-dup-type": + entries.append((entries[-1][0], b"zz")) + if defect == "sni-empty-host": + entries[0] = (0, b"") + v = sni_value(entries) + if defect == "sni-list-len": + v = be16(len(v)) + v[2:] + return (0, v) + + +def gen_alpn(rng, defect): + names = [bytes(rng.choice(b"abcdefg0123456789/.-") + for _ in range(rng.randrange(1, 9))) + for _ in range(rng.randrange(1, 4))] + if defect == "alpn-empty-name": + names.insert(0, b"") + v = alpn_value(names) + if defect == "alpn-list-len": + v = be16(len(v) + 2) + v[2:] + return (16, v) + + +def gen_sv(rng, defect): + versions = [rng.choice([0x0300, 0x0301, 0x0302, 0x0303, + 0x0304, 0x7F1C]) + for _ in range(rng.randrange(1, 5))] + if defect == "sv-odd": + return (43, bytes([3, 3, 4, 3])) + if defect == "sv-zero": + return (43, bytes([0])) + if defect == "sv-len-lie": + v = sv_value(versions) + return (43, bytes([v[0] + 2]) + v[1:]) + return (43, sv_value(versions)) + + +def gen_ks(rng, defect): + groups = rng.sample([29, 23, 24, 25, 256, 257], + rng.randrange(1, 4)) + shares = [(g, bytes(rng.randrange(256) + for _ in range(rng.choice([1, 32, 65])))) + for g in groups] + if defect == "ks-dup-group": + shares.append((shares[0][0], b"\x09" * 8)) + if defect == "ks-empty-key": + shares[0] = (shares[0][0], b"") + v = ks_value(shares) + if defect == "ks-list-len": + v = be16(len(v)) + v[2:] + return (51, v) + + +def gen_opaque(rng, taken): + choices = [t for t in [5, 10, 11, 13, 21, 23, 35, 42, 44, + 45, 49, 50, 300, 1000, 65281] + if t not in taken] + t = rng.choice(choices) + v = bytes(rng.randrange(256) + for _ in range(rng.choice([0, 1, 4, 17, 40]))) + return (t, v) + + +DEFECTS = [None, None, None, "dup-ext", "no-ext-block", + "trailing", "rec-len", "hs-len", "sess33", + "suites-empty", "comps-no-null", "comps-empty", + "sni-second-host", "sni-dup-type", "sni-empty-host", + "sni-list-len", "alpn-empty-name", "alpn-list-len", + "sv-odd", "sv-zero", "sv-len-lie", "ks-dup-group", + "ks-empty-key", "ks-list-len"] + + +def gen_message(rng): + defect = rng.choice(DEFECTS) + session_id = bytes(rng.randrange(256) + for _ in range(rng.choice([0, 0, 1, 8, 32]))) + if defect == "sess33": + session_id = bytes(33) + nsuites = rng.choice([1, 1, 2, 3, 4, 6]) + if defect == "suites-empty": + nsuites = 0 + suites = [rng.randrange(65536) for _ in range(nsuites)] + comps = [0] + if rng.random() < 0.3: + comps = [0, 1] + if defect == "comps-no-null": + comps = [1, 2] + if defect == "comps-empty": + comps = [] + builders = [gen_sni, gen_alpn, gen_sv, gen_ks] + rng.shuffle(builders) + nexts = rng.randrange(0, 5) + chosen = builders[:nexts] + exts = [] + taken = set() + for b in chosen: + e = b(rng, defect) + exts.append(e) + taken.add(e[0]) + if rng.random() < 0.5: + e = gen_opaque(rng, taken) + exts.insert(rng.randrange(len(exts) + 1), e) + taken.add(e[0]) + if defect == "dup-ext" and exts: + exts.append(exts[0]) + rng.shuffle(exts) + return build_hello( + record_version=bytes([rng.randrange(256), + rng.randrange(256)]), + legacy_version=bytes([rng.randrange(256), + rng.randrange(256)]), + random_bytes=bytes(rng.randrange(256) for _ in range(32)), + session_id=session_id, suites=suites, comps=comps, + exts=exts, ext_block=(defect != "no-ext-block"), + record_len_delta=(5 if defect == "rec-len" else 0), + hs_len_delta=(1 if defect == "hs-len" else 0), + trailing=(b"\xaa" if defect == "trailing" else b"")) + + +def gen_mutations(rng): + out = [] + for i in range(len(FULL_HELLO)): + out.append(FULL_HELLO[:i]) + for i in range(len(FULL_HELLO)): + for d in (0x01, 0x80, 0xFF): + b = bytearray(FULL_HELLO) + b[i] ^= d + out.append(bytes(b)) + for _ in range(300): + b = bytearray(FULL_HELLO) + for _ in range(rng.randrange(1, 9)): + op = rng.randrange(3) + pos = rng.randrange(len(b) + (1 if op == 1 else 0)) + if op == 0 and b: + b[pos % len(b)] = rng.randrange(256) + elif op == 1: + b.insert(pos, rng.randrange(256)) + elif op == 2 and b: + del b[pos % len(b)] + out.append(bytes(b)) + return out + + +def gen_random_raw(rng): + out = [] + for _ in range(300): + n = rng.randrange(0, 320) + b = bytes(rng.randrange(256) for _ in range(n)) + if n > 0 and rng.random() < 0.5: + b = bytes([22]) + b[1:] + out.append(b) + return out + + +# ---------------------------------------------------------------- +# The runner. +# ---------------------------------------------------------------- + +def run_batch(lines, timeout=120): + """Run the tool on request lines; return answer lines.""" + proc = subprocess.Popen( + [str(EXE)], stdin=subprocess.PIPE, stdout=subprocess.PIPE, + stderr=subprocess.PIPE) + out_lines = [] + err = [] + + def drain(): + try: + data = proc.stdout.read() + out_lines.extend(data.decode().splitlines()) + except Exception: + pass + + t = threading.Thread(target=drain, daemon=True) + t.start() + try: + proc.stdin.write(("\n".join(lines) + "\n").encode()) + proc.stdin.close() + except BrokenPipeError: + pass + t.join(timeout) + if t.is_alive(): + proc.kill() + raise TimeoutError("tool did not finish in time") + err = proc.stderr.read().decode() + if err.strip(): + raise RuntimeError(f"tool wrote to stderr: {err[:400]}") + return out_lines + + +def codes(bs): + return ",".join(str(b) for b in bs) + + +def expected_answer(bs): + rep = oracle_parse(bs) + if rep is None: + return "none" + return "ok:" + codes(rep) + + +def check_batch(cases, label, failures): + """cases: list of byte strings. Returns (run, agreed).""" + lines = [] + for bs in cases: + if bs: + lines.append("parse " + codes(bs)) + else: + lines.append("parse") + answers = [] + chunk = 400 + for i in range(0, len(lines), chunk): + answers.extend(run_batch(lines[i:i + chunk])) + if len(answers) != len(cases): + failures.append( + f"{label}: got {len(answers)} answers for " + f"{len(cases)} cases") + return len(cases), 0 + agreed = 0 + for bs, got in zip(cases, answers): + want = expected_answer(bs) + if got == want: + agreed += 1 + elif len(failures) < 25: + failures.append( + f"{label}: input {codes(bs)[:120]}... " + f"tool said {got[:80]}, oracle said {want[:80]}") + return len(cases), agreed + + +def main(): + ap = argparse.ArgumentParser() + ap.add_argument("--seed", type=int, default=20261026) + ap.add_argument("--count", type=int, default=3200) + args = ap.parse_args() + rng = random.Random(args.seed) + + env = dict(os.environ) + if not any(Path(p, "lake").exists() + for p in env.get("PATH", "").split(":")): + env["PATH"] = (str(Path.home() / ".elan" / "bin") + + ":" + env.get("PATH", "")) + build = subprocess.run( + ["lake", "build"], cwd=ROOT, capture_output=True, + text=True, timeout=1200, env=env) + if build.returncode != 0: + print(build.stdout[-2000:]) + print(build.stderr[-2000:]) + print("lake build failed", file=sys.stderr) + return 1 + + failures = [] + tally = {} + + named = named_cases() + agreed_named = 0 + named_lines = [] + named_want = [] + for name, bs, want_ok in named: + rep = oracle_parse(bs) + oracle_ok = rep is not None + if oracle_ok != want_ok: + failures.append( + f"named case {name}: oracle " + f"{'accepts' if oracle_ok else 'rejects'}, " + f"the case expects " + f"{'accept' if want_ok else 'reject'}") + named_lines.append(bs) + named_want.append(name) + n, a = check_batch(named_lines, "named", failures) + tally["named cases"] = (n, a) + + gen = [gen_message(rng) for _ in range(args.count)] + n, a = check_batch(gen, "generated", failures) + tally["generated messages"] = (n, a) + gen_accepted = sum(1 for bs in gen + if oracle_parse(bs) is not None) + + mut = gen_mutations(rng) + n, a = check_batch(mut, "mutations", failures) + tally["mutations of the full hello"] = (n, a) + + raw = gen_random_raw(rng) + n, a = check_batch(raw, "random raw", failures) + tally["random raw byte strings"] = (n, a) + + malformed = ["parse 256", "parse 1,x", "parse 1,,2", + "peek 1,2", "parse -1", "parse 1 2", + "parse 999999999999"] + bad_agreed = 0 + for line in malformed: + got = run_batch([line]) + if got == ["error"]: + bad_agreed += 1 + else: + failures.append( + f"malformed line {line!r}: got {got}") + tally["malformed request lines"] = (len(malformed), + bad_agreed) + + total = sum(n for n, _ in tally.values()) + agreed = sum(a for _, a in tally.values()) + + lines = [] + lines.append("# ClientHello slice: test results") + lines.append("") + lines.append(f"Run: python3 tests/run_tests.py " + f"--seed {args.seed} --count {args.count}") + lines.append(f"Seed: {args.seed}. " + f"Python {platform.python_version()}.") + lines.append("") + lines.append("## Oracles") + lines.append("") + lines.append("Every verdict is settled by the harness " + "oracle, a Python implementation of the rules " + "in SPEC.md written for these tests. The tool " + "must agree with the oracle on every input, " + "and an accepted message must reprint to the " + "oracle's canonical reprint byte for byte.") + lines.append("") + lines.append("Python's ssl module cannot build a " + "ClientHello on demand. Go is not installed " + "(`go version` fails). Scapy 2.8.0 is present " + "in the sibling dhcp project's venv and its " + "TLS submodules import, but building or " + "dissecting a TLS record raises NameError " + "inside scapy's crypto support (HMAC is not " + "defined), so Scapy could not be used as a " + "byte source. No capture was fetched; the " + "fixed cases are built by hand from the RFCs.") + lines.append("") + lines.append("## Counts") + lines.append("") + lines.append("| part | run | agreed |") + lines.append("| --- | --- | --- |") + for label, (n, a) in tally.items(): + lines.append(f"| {label} | {n} | {a} |") + lines.append(f"| total | {total} | {agreed} |") + lines.append("") + lines.append(f"Of the {tally['generated messages'][0]} " + f"generated messages, the oracle accepts " + f"{gen_accepted} and rejects " + f"{tally['generated messages'][0] - gen_accepted}.") + lines.append("") + lines.append("## Named cases") + lines.append("") + for name, bs, want_ok in named: + lines.append(f"- {name}: " + f"{'accept' if want_ok else 'reject'} " + f"({len(bs)} bytes)") + lines.append("") + lines.append("## Differences") + lines.append("") + if failures: + lines.append(f"{len(failures)} failure(s):") + lines.append("") + for f in failures: + lines.append(f"- {f}") + else: + lines.append("No disagreements between the tool and " + "the oracle, and every named case matched " + "its stated expectation.") + lines.append("") + RESULTS.write_text("\n".join(lines)) + print(f"run {total}, agreed {agreed}, " + f"failures {len(failures)}") + for f in failures: + print("FAIL:", f) + return 0 if not failures else 1 + + +if __name__ == "__main__": + sys.exit(main()) From e4c149afb9202e33fc08745f85c5002dc2d1e3bf Mon Sep 17 00:00:00 2001 From: shah Date: Tue, 27 Oct 2026 19:51:37 -0500 Subject: [PATCH 02/19] Add the bar file set: Spec.lean, comparator.json, bar.toml, CI workflow --- .github/workflows/bar.yml | 21 ++++++ Proofs.lean | 1 + Proofs/SpecProofs.lean | 154 +++++++++++++++++++++++++++++++++++++ README.md | 110 ++++++++++++++++++++------- SPEC.md | 39 ++++++++++ Spec.lean | 155 ++++++++++++++++++++++++++++++++++++++ bar.toml | 53 +++++++++++++ comparator.json | 39 ++++++++++ lakefile.toml | 3 + 9 files changed, 548 insertions(+), 27 deletions(-) create mode 100644 .github/workflows/bar.yml create mode 100644 Proofs/SpecProofs.lean create mode 100644 Spec.lean create mode 100644 bar.toml create mode 100644 comparator.json diff --git a/.github/workflows/bar.yml b/.github/workflows/bar.yml new file mode 100644 index 0000000..32457ed --- /dev/null +++ b/.github/workflows/bar.yml @@ -0,0 +1,21 @@ +name: verified bar + +on: + push: + pull_request: + # Rerun when the spec reviewer approves, or an approval is dismissed. + pull_request_review: + types: [submitted, dismissed] + +jobs: + bar: + # pull-requests: read lets the check confirm the spec approval on GitHub. + permissions: + contents: read + pull-requests: read + # Both lines pin the same commit of Proven-Commons/mission: bar v2, as + # proposed in its pull request #2. Move both to a release tag once + # mission publishes one. + uses: Proven-Commons/mission/.github/workflows/verified-bar.yml@6ba85c27abaaf07905c9316aa96dc29f7b5847a2 + with: + bar-ref: 6ba85c27abaaf07905c9316aa96dc29f7b5847a2 diff --git a/Proofs.lean b/Proofs.lean index b877d25..36165f5 100644 --- a/Proofs.lean +++ b/Proofs.lean @@ -1,2 +1,3 @@ import Proofs.RoundTrip +import Proofs.SpecProofs import Proofs.Verify diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean new file mode 100644 index 0000000..bbaf935 --- /dev/null +++ b/Proofs/SpecProofs.lean @@ -0,0 +1,154 @@ +/- + Proofs of the statements in `Spec.lean`, under the same names. + + The two round trips are the theorems proved in + `Proofs/RoundTrip.lean`. The examples are single inputs, checked + in the kernel with `decide +kernel`: no native evaluation, which + the bar forbids. +-/ + +import ClientHello +import Proofs.RoundTrip + +open ClientHello + +theorem Spec.parse_print (m : Message) (hw : WF m) : + parse (print m) = some m := + ClientHello.Proofs.parse_print m hw + +theorem Spec.print_parse {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) : + print m = bs ∧ WF m := + ClientHello.Proofs.print_parse hparse + + +theorem Spec.accepts_empty_extensions : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8) := by + decide +kernel + + +theorem Spec.accepts_supported_versions : + (parse ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).map print = + some ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8) := by + decide +kernel + + +theorem Spec.rejects_empty : + (parse ([] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_short_header : + (parse ([22, 3] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_record_length_zero : + (parse ([22, 3, 1, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_content_type : + (parse ([23, 3, 1, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_record_length_longer : + (parse ([22, 3, 1, 0, 10, 1, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_trailing_bytes : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_handshake_type : + (parse ([22, 3, 1, 0, 4, 2, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_handshake_length : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_missing_extensions : + (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_session_id_33 : + (parse ([22, 3, 1, 0, 39, 1, 0, 0, 35, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_odd_cipher_suites : + (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_empty_cipher_suites : + (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_compression_without_null : + (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_empty_compression : + (parse ([22, 3, 1, 0, 44, 1, 0, 0, 40, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_duplicate_extension : + (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_extension_overrun : + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 0, 0, 10, 2, 3, 4] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_duplicate_key_share_group : + (parse ([22, 3, 1, 0, 63, 1, 0, 0, 59, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 16, 0, 51, 0, 12, 0, 10, 0, 29, 0, 1, 1, 0, 29, 0, 1, 2] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_key_share_empty_key : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 10, 0, 51, 0, 6, 0, 4, 0, 29, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_key_share_empty_list : + (parse ([22, 3, 1, 0, 53, 1, 0, 0, 49, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 6, 0, 51, 0, 2, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_supported_versions_odd : + (parse ([22, 3, 1, 0, 55, 1, 0, 0, 51, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 8, 0, 43, 0, 4, 3, 3, 4, 3] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_supported_versions_zero : + (parse ([22, 3, 1, 0, 52, 1, 0, 0, 48, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 5, 0, 43, 0, 1, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_alpn_empty_name : + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 16, 0, 3, 0, 1, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_sni_second_host_name : + (parse ([22, 3, 1, 0, 77, 1, 0, 0, 73, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 30, 0, 0, 0, 26, 0, 24, 0, 0, 9, 97, 46, 101, 120, 97, 109, 112, 108, 101, 0, 0, 9, 98, 46, 101, 120, 97, 109, 112, 108, 101] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_sni_list_length : + (parse ([22, 3, 1, 0, 67, 1, 0, 0, 63, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 20, 0, 0, 0, 16, 0, 99, 0, 0, 11, 101, 120, 97, 109, 112, 108, 101, 46, 99, 111, 109] : List UInt8)).isSome = false := by + decide +kernel diff --git a/README.md b/README.md index be6ebff..848f7b9 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # clienthello: a TLS ClientHello parser and printer, with proved round trips +Status: in-progress + A parser and printer for the TLS ClientHello message, in Lean, following RFC 8446 section 4.1.2, with the legacy fields carried from RFC 5246, the server name indication @@ -11,10 +13,10 @@ written out in `SPEC.md`. This slice reads one TLS record holding one ClientHello; it does no handshake crypto and parses no certificates. -Status: the specification has not been approved by a -reviewer, so do not call this verified. The statements a -reviewer approves (the bar's `Spec.lean`) have not been -added yet. +The statements a reviewer approves are in `Spec.lean`, +with their proofs in `Proofs/SpecProofs.lean`. No reviewer +has approved them yet, so this project is not called +verified. ## How to run it @@ -33,10 +35,42 @@ against the harness oracle, and writes the outcome to ## What is proved +Each claim below names the theorem behind it. The +theorems are stated in `Spec.lean` (the challenge file, +where they end in `sorry`) and proved in +`Proofs/SpecProofs.lean`, under the same names. +`comparator.json` lists all of them. + | Claim | Theorem | |-------|---------| -| Parsing the printed form of a well formed message gives the message back. | `ClientHello.Proofs.parse_print` | -| Printing a message the parser took gives the same bytes it was read from. | `ClientHello.Proofs.print_parse` | +| Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | +| Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | +| A hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | +| A minimal hello carrying only supported_versions is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | +| Empty input is refused. | `Spec.rejects_empty` | +| Input shorter than the record header is refused. | `Spec.rejects_short_header` | +| A record length of 0 is refused. | `Spec.rejects_record_length_zero` | +| A content type other than 22 is refused. | `Spec.rejects_content_type` | +| A record length longer than the input is refused. | `Spec.rejects_record_length_longer` | +| Bytes after the record are refused. | `Spec.rejects_trailing_bytes` | +| A handshake type other than 1 is refused. | `Spec.rejects_handshake_type` | +| A handshake length that does not match the body is refused. | `Spec.rejects_handshake_length` | +| A body with no extensions block is refused. | `Spec.rejects_missing_extensions` | +| A session id length of 33 is refused. | `Spec.rejects_session_id_33` | +| A cipher suite list with an odd byte length is refused. | `Spec.rejects_odd_cipher_suites` | +| An empty cipher suite list is refused. | `Spec.rejects_empty_cipher_suites` | +| Compression methods without the null method 0 are refused. | `Spec.rejects_compression_without_null` | +| An empty compression method list is refused. | `Spec.rejects_empty_compression` | +| An extension type standing twice is refused. | `Spec.rejects_duplicate_extension` | +| An extension length running past the block is refused. | `Spec.rejects_extension_overrun` | +| A key share group standing twice is refused. | `Spec.rejects_duplicate_key_share_group` | +| A key share entry with empty key bytes is refused. | `Spec.rejects_key_share_empty_key` | +| A key_share value with no entries is refused. | `Spec.rejects_key_share_empty_list` | +| A supported_versions value with an odd length is refused. | `Spec.rejects_supported_versions_odd` | +| A supported_versions value with length 0 is refused. | `Spec.rejects_supported_versions_zero` | +| An ALPN value with an empty protocol name is refused. | `Spec.rejects_alpn_empty_name` | +| A server_name value with two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | +| A server_name list length that does not cover the value is refused. | `Spec.rejects_sni_list_length` | A message is well formed when the record version and the legacy version each fit two bytes; the random holds @@ -54,24 +88,29 @@ extensions block fits two bytes of length; and the printed body fields fit the three byte handshake length with room to spare (at most 65531 bytes). -Both theorems check against the standard axioms only -(`propext`, `Classical.choice`, `Quot.sound`), which a -reader can confirm with `#print axioms` on +The two round trip theorems rest on the proofs in +`Proofs/RoundTrip.lean`, where they are `ClientHello.Proofs.parse_print` and -`ClientHello.Proofs.print_parse`; `Proofs/Verify.lean` -prints them at build time. +`ClientHello.Proofs.print_parse`. Both check against the +standard axioms only (`propext`, `Classical.choice`, +`Quot.sound`), which a reader can confirm with +`#print axioms`; `Proofs/Verify.lean` prints them at +build time. The example theorems are single inputs +checked in the kernel with `decide +kernel`. -The command line tool in `Main.lean` calls these -functions directly. +The command line tool in `Main.lean` calls +`ClientHello.parse` and `ClientHello.print` directly, +the same functions the theorems are about. ## What is not proved - That the parser accepts every message the rules in `SPEC.md` allow, and turns away every message they - forbid. The round trips do not need either, so neither - is proved. The differential tests in `tests/` check - that behaviour instead, and the results file records - the outcome, including any failure. + forbid. The round trips do not need either, and the + example theorems pin single inputs only, so neither + holds in general as a proof. The differential tests in + `tests/` check that behaviour instead, and the results + file records the outcome, including any failure. - The meaning of any extension other than the four decoded ones. Every other extension is carried as its type and value bytes, and no per extension content rule @@ -85,7 +124,15 @@ functions directly. ## What you must trust -- The Lean toolchain (Lean 4.35.0) and its kernel. +- The Lean kernel (Lean 4.35.0, pinned in + `lean-toolchain`), which checks every proof. +- The Lean compiler, which turns the proved definitions + into the program that runs. +- The Lean runtime, which runs that program. +- The hardware the program runs on. +- Every dependency in `lake-manifest.json`: the manifest + lists no packages, so there are no library dependencies + to trust beyond the Lean toolchain itself. - That `SPEC.md` states the reading of the RFCs you intend. The proofs are about the parser and printer in this repo following each other exactly; the fidelity of @@ -97,15 +144,24 @@ functions directly. - The line handling in `Main.lean` (splitting a request line, reading decimal codes). The tests drive it, and no proof covers it. - -## How to re-check it - -1. `lake build`: the library, the proofs, and the tool - build clean, and the build prints the axiom list for - both theorems. +- There are no exceptions to item 4 of the bar: the + project uses none of the features it forbids. + +## Re-check it + +1. `lake comparator --paranoid`: builds the challenge + file `Spec.lean` and the proofs in a sandbox and + checks that each theorem named in `comparator.json` + proves exactly the statement in the challenge file, + uses no axiom but the three standard ones, and is + accepted by Lean's kernel and every other kernel + shipped with Lean. 2. `python3 tests/run_tests.py`: the fixed cases, the - named rejections, and the differential run against the - oracle, with counts and any failures written to + named rejections, and the differential run against + the oracle, with counts and any failures written to `tests/TEST-RESULTS.md`. -3. Read `SPEC.md` against RFC 8446 section 4.1.2 and +3. `lake build`: the library, the proofs, and the tool + build clean, and the build prints the axiom list for + both round trip theorems. +4. Read `SPEC.md` against RFC 8446 section 4.1.2 and check the pinned readings are the ones you want. diff --git a/SPEC.md b/SPEC.md index 78ebecc..71a123b 100644 --- a/SPEC.md +++ b/SPEC.md @@ -142,6 +142,45 @@ slice pins it: - Unknown extension types are carried opaque. - A duplicate key share group rejects. +## Properties and their theorems + +Each property a reader can check in the page (`README.md`) +names its theorem. The theorems are stated in `Spec.lean` +and proved in `Proofs/SpecProofs.lean`. The example +theorems are single inputs; the tests in `tests/` cover +each rule on many more inputs. + +| Property | Theorem | +|----------|---------| +| Parsing the printed form of a well formed message gives the message back | `Spec.parse_print` | +| A message the parser took prints back to the bytes it was read from, and is well formed | `Spec.print_parse` | +| A present, empty extensions block is accepted | `Spec.accepts_empty_extensions` | +| A minimal hello with only supported_versions is accepted | `Spec.accepts_supported_versions` | +| Empty input is refused | `Spec.rejects_empty` | +| Input shorter than the record header is refused | `Spec.rejects_short_header` | +| A record length of 0 is refused | `Spec.rejects_record_length_zero` | +| A content type other than 22 is refused | `Spec.rejects_content_type` | +| A record length longer than the input is refused | `Spec.rejects_record_length_longer` | +| Bytes after the record are refused | `Spec.rejects_trailing_bytes` | +| A handshake type other than 1 is refused | `Spec.rejects_handshake_type` | +| A handshake length that does not match the body is refused | `Spec.rejects_handshake_length` | +| A body with no extensions block is refused | `Spec.rejects_missing_extensions` | +| A session id length over 32 is refused | `Spec.rejects_session_id_33` | +| A cipher suite list with an odd byte length is refused | `Spec.rejects_odd_cipher_suites` | +| An empty cipher suite list is refused | `Spec.rejects_empty_cipher_suites` | +| Compression methods must contain the null method 0 | `Spec.rejects_compression_without_null` | +| An empty compression method list is refused | `Spec.rejects_empty_compression` | +| A duplicate extension type is refused | `Spec.rejects_duplicate_extension` | +| An extension length running past the block is refused | `Spec.rejects_extension_overrun` | +| A duplicate key share group is refused | `Spec.rejects_duplicate_key_share_group` | +| A key share entry with empty key bytes is refused | `Spec.rejects_key_share_empty_key` | +| A key_share value with no entries is refused | `Spec.rejects_key_share_empty_list` | +| A supported_versions value with an odd length is refused | `Spec.rejects_supported_versions_odd` | +| A supported_versions value with length 0 is refused | `Spec.rejects_supported_versions_zero` | +| An ALPN value with an empty protocol name is refused | `Spec.rejects_alpn_empty_name` | +| A server_name value with two host_name entries is refused | `Spec.rejects_sni_second_host_name` | +| A server_name list length that does not cover the value is refused | `Spec.rejects_sni_list_length` | + ## Safety The parser never reads past the end of its input. Every diff --git a/Spec.lean b/Spec.lean new file mode 100644 index 0000000..428c659 --- /dev/null +++ b/Spec.lean @@ -0,0 +1,155 @@ +/- + The specification as Lean statements: the challenge file. + + A reviewer who did not write this file approves it, and `bar.toml` + records the SHA-256 it had then. The proofs live in `Proofs` + (`Proofs/SpecProofs.lean`); `lake comparator` checks that each one + proves exactly the statement written here. The `sorry` below is + expected in this file only. + + The statements use only the definitions in `ClientHello/Value.lean` + and `ClientHello/Parse.lean`, the code under proof named in + `bar.toml`. No definition of their own is needed, so this project + has no `Spec/Defs.lean`. +-/ + +import ClientHello + +open ClientHello + +/-! ## The round trips + +The two statements the slice stands on. Each one is the statement of +the proved theorem of the same shape in `Proofs/RoundTrip.lean`, over +the same well formedness predicate, `ClientHello.WF`. -/ + +/-- Parsing the printed form of a well formed message gives the + message back. -/ +theorem Spec.parse_print (m : Message) (hw : WF m) : + parse (print m) = some m := sorry + +/-- A message the parser took prints back to the bytes it was read + from, and the message is well formed. So a printer that wrote + nothing, or wrote something shorter, fails the first half. -/ +theorem Spec.print_parse {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) : + print m = bs ∧ WF m := sorry + +/-! ## Accepted examples + +Single inputs the parser accepts. Each one is stated in the form the +round trip gives for a single input: parsing the bytes and printing +the result gives the same bytes back. -/ + +/-- A hello whose extensions block is present and empty is accepted, and writes back as the same bytes. -/ +theorem Spec.accepts_empty_extensions : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8) := sorry + +/-- A minimal hello carrying only a supported_versions extension is accepted, and writes back as the same bytes. -/ +theorem Spec.accepts_supported_versions : + (parse ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).map print = + some ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8) := sorry + +/-! ## Refused inputs + +Single inputs the parser refuses, one for each headline rule of +`SPEC.md`. The differential tests cover these rules on many more +inputs; these statements pin them so a reader of the specification +can check each rule against one concrete case. -/ + +/-- Empty input is refused: it is not a record with an empty body. -/ +theorem Spec.rejects_empty : + (parse ([] : List UInt8)).isSome = false := sorry + +/-- Input shorter than the five byte record header is refused. -/ +theorem Spec.rejects_short_header : + (parse ([22, 3] : List UInt8)).isSome = false := sorry + +/-- A record length of 0 is refused: an empty body cannot hold a ClientHello. -/ +theorem Spec.rejects_record_length_zero : + (parse ([22, 3, 1, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A content type other than 22 (handshake) is refused. -/ +theorem Spec.rejects_content_type : + (parse ([23, 3, 1, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A record length longer than the input is refused rather than read past the end. -/ +theorem Spec.rejects_record_length_longer : + (parse ([22, 3, 1, 0, 10, 1, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- Bytes after the record are refused rather than ignored. -/ +theorem Spec.rejects_trailing_bytes : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A handshake type other than 1 (client_hello) is refused. -/ +theorem Spec.rejects_handshake_type : + (parse ([22, 3, 1, 0, 4, 2, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A handshake length that does not equal the remaining body length is refused. -/ +theorem Spec.rejects_handshake_length : + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A body that ends after the compression methods, with no extensions block, is refused. -/ +theorem Spec.rejects_missing_extensions : + (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0] : List UInt8)).isSome = false := sorry + +/-- A session id length of 33 is refused: the limit is 32. -/ +theorem Spec.rejects_session_id_33 : + (parse ([22, 3, 1, 0, 39, 1, 0, 0, 35, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33] : List UInt8)).isSome = false := sorry + +/-- A cipher suite list with an odd byte length is refused. -/ +theorem Spec.rejects_odd_cipher_suites : + (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3] : List UInt8)).isSome = false := sorry + +/-- An empty cipher suite list is refused. -/ +theorem Spec.rejects_empty_cipher_suites : + (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- Compression methods that do not contain the null method 0 are refused. -/ +theorem Spec.rejects_compression_without_null : + (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1] : List UInt8)).isSome = false := sorry + +/-- An empty compression method list is refused. -/ +theorem Spec.rejects_empty_compression : + (parse ([22, 3, 1, 0, 44, 1, 0, 0, 40, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0] : List UInt8)).isSome = false := sorry + +/-- An extension type standing twice in one block is refused. -/ +theorem Spec.rejects_duplicate_extension : + (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := sorry + +/-- An extension length that runs past the end of the block is refused. -/ +theorem Spec.rejects_extension_overrun : + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 0, 0, 10, 2, 3, 4] : List UInt8)).isSome = false := sorry + +/-- A key share group standing twice in one key_share value is refused. -/ +theorem Spec.rejects_duplicate_key_share_group : + (parse ([22, 3, 1, 0, 63, 1, 0, 0, 59, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 16, 0, 51, 0, 12, 0, 10, 0, 29, 0, 1, 1, 0, 29, 0, 1, 2] : List UInt8)).isSome = false := sorry + +/-- A key share entry with empty key exchange bytes is refused. -/ +theorem Spec.rejects_key_share_empty_key : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 10, 0, 51, 0, 6, 0, 4, 0, 29, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A key_share value with no entries is refused. -/ +theorem Spec.rejects_key_share_empty_list : + (parse ([22, 3, 1, 0, 53, 1, 0, 0, 49, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 6, 0, 51, 0, 2, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A supported_versions value with an odd byte length is refused. -/ +theorem Spec.rejects_supported_versions_odd : + (parse ([22, 3, 1, 0, 55, 1, 0, 0, 51, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 8, 0, 43, 0, 4, 3, 3, 4, 3] : List UInt8)).isSome = false := sorry + +/-- A supported_versions value with a length of 0 is refused. -/ +theorem Spec.rejects_supported_versions_zero : + (parse ([22, 3, 1, 0, 52, 1, 0, 0, 48, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 5, 0, 43, 0, 1, 0] : List UInt8)).isSome = false := sorry + +/-- An ALPN value holding an empty protocol name is refused. -/ +theorem Spec.rejects_alpn_empty_name : + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 16, 0, 3, 0, 1, 0] : List UInt8)).isSome = false := sorry + +/-- A server_name value with two host_name entries is refused. -/ +theorem Spec.rejects_sni_second_host_name : + (parse ([22, 3, 1, 0, 77, 1, 0, 0, 73, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 30, 0, 0, 0, 26, 0, 24, 0, 0, 9, 97, 46, 101, 120, 97, 109, 112, 108, 101, 0, 0, 9, 98, 46, 101, 120, 97, 109, 112, 108, 101] : List UInt8)).isSome = false := sorry + +/-- A server_name value whose list length does not cover the rest of the value is refused. -/ +theorem Spec.rejects_sni_list_length : + (parse ([22, 3, 1, 0, 67, 1, 0, 0, 63, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 20, 0, 0, 0, 16, 0, 99, 0, 0, 11, 101, 120, 97, 109, 112, 108, 101, 46, 99, 111, 109] : List UInt8)).isSome = false := sorry diff --git a/bar.toml b/bar.toml new file mode 100644 index 0000000..afebc16 --- /dev/null +++ b/bar.toml @@ -0,0 +1,53 @@ +# Read by bar/check.py in Proven-Commons/mission. +# See playbook/verified-bar.md there for what each field means. + +[project] +name = "clienthello" +# "in-progress" until every bar item passes, then "verified". +status = "in-progress" +page = "README.md" +# GitHub handles of everyone who wrote the specification. +spec_authors = ["abu-aska"] +# The program people run. A change to it voids the approval. +entry_points = ["Main.lean"] + +[spec] +files = ["SPEC.md", "Spec.lean"] +# The code under proof: the functions the statements are about. +code = [ + # The data types the statements are about, and their constructors. + "ClientHello.Message", "ClientHello.Hello", "ClientHello.Extension", + "ClientHello.Extension.serverName", "ClientHello.Extension.alpn", + "ClientHello.Extension.supportedVersions", "ClientHello.Extension.keyShare", + "ClientHello.Extension.opaque", + # The byte forms and the printer. + "ClientHello.be16", "ClientHello.u16", "ClientHello.be24", "ClientHello.u24", + "ClientHello.extType", "ClientHello.printPairs", "ClientHello.printNameEntries", + "ClientHello.printAlpnNames", "ClientHello.printShares", + "ClientHello.printExtValue", "ClientHello.printExt", "ClientHello.printExts", + "ClientHello.printBodyFields", "ClientHello.printBody", "ClientHello.print", + # Well formedness. + "ClientHello.ExtWF", "ClientHello.WF", + # The length checked readers and the parser. + "ClientHello.getU8", "ClientHello.getU16", "ClientHello.getU24", + "ClientHello.getBytes", "ClientHello.parsePairs", + "ClientHello.parseNameEntriesGo", "ClientHello.parseNameEntries", + "ClientHello.validNames", "ClientHello.parseSNI", + "ClientHello.parseAlpnGo", "ClientHello.parseAlpnNames", "ClientHello.parseALPN", + "ClientHello.parseSV", "ClientHello.parseSharesGo", "ClientHello.parseShares", + "ClientHello.parseKS", "ClientHello.parseExtValue", + "ClientHello.parseExtsGo", "ClientHello.parseExts", + "ClientHello.parseBodyFields", "ClientHello.parseBody", "ClientHello.parse", +] + +# One entry per approval, added in a pull request the reviewer approves. +# [[spec.approval]] +# reviewer = "github-handle" +# date = "2026-11-02" +# sha256 = "..." +# record = "https://github.com/Proven-Commons/clienthello/pull/" + +[tests] +results = "tests/TEST-RESULTS.md" +command = "python3 tests/run_tests.py" +files = ["tests/run_tests.py"] diff --git a/comparator.json b/comparator.json new file mode 100644 index 0000000..96381be --- /dev/null +++ b/comparator.json @@ -0,0 +1,39 @@ +{ + "challenge_module": "Spec", + "solution_module": "Proofs", + "theorem_names": [ + "Spec.parse_print", + "Spec.print_parse", + "Spec.accepts_empty_extensions", + "Spec.accepts_supported_versions", + "Spec.rejects_empty", + "Spec.rejects_short_header", + "Spec.rejects_record_length_zero", + "Spec.rejects_content_type", + "Spec.rejects_record_length_longer", + "Spec.rejects_trailing_bytes", + "Spec.rejects_handshake_type", + "Spec.rejects_handshake_length", + "Spec.rejects_missing_extensions", + "Spec.rejects_session_id_33", + "Spec.rejects_odd_cipher_suites", + "Spec.rejects_empty_cipher_suites", + "Spec.rejects_compression_without_null", + "Spec.rejects_empty_compression", + "Spec.rejects_duplicate_extension", + "Spec.rejects_extension_overrun", + "Spec.rejects_duplicate_key_share_group", + "Spec.rejects_key_share_empty_key", + "Spec.rejects_key_share_empty_list", + "Spec.rejects_supported_versions_odd", + "Spec.rejects_supported_versions_zero", + "Spec.rejects_alpn_empty_name", + "Spec.rejects_sni_second_host_name", + "Spec.rejects_sni_list_length" + ], + "permitted_axioms": [ + "propext", + "Classical.choice", + "Quot.sound" + ] +} diff --git a/lakefile.toml b/lakefile.toml index 0a3c41e..700b760 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -8,6 +8,9 @@ name = "ClientHello" [[lean_lib]] name = "Proofs" +[[lean_lib]] +name = "Spec" + [[lean_exe]] name = "clienthello" root = "Main" From 1a8dde077a0f43704dc83bad96f22c63134d9c28 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 17:58:05 +0000 Subject: [PATCH 03/19] Accept an empty key_share client_shares list Review 1 finding 1 and the e4c149a reviews (blocking): parseKS refused a key_share whose client_shares list is empty, and WF required ss <> []. RFC 8446 section 4.2.8 says the vector MAY be empty, which is how a client asks for a HelloRetryRequest, so the refusal was a misreading, and Spec.rejects_key_share_empty_list asked a reviewer to approve it. - Parse.lean: parseKS no longer tests ss.isEmpty. - Value.lean: ExtWF for keyShare no longer requires ss <> []. - Proofs: parseKS_print and parseKS_inv follow; the ExtWF uses in printExtValue_length_le and parseExtValue_printExtValue drop the removed conjunct. - Spec.lean: Spec.rejects_key_share_empty_list becomes Spec.accepts_key_share_empty_list, on the reviewers' 83-byte TLS 1.3 probe (supported_groups, supported_versions 0x0304, key_share 00 00, signature_algorithms). comparator.json names it. - SPEC.md, README: the rule and the table rows say the list may be empty. - tests: the harness oracle accepts an empty list, the named case now expects accept, the probe is a named case, and the generator makes empty lists. TEST-RESULTS.md is from the new run. - bar.toml: zero-aska added to spec_authors, since the spec files changed. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 7 +++-- ClientHello/Value.lean | 1 - Proofs/RoundTrip.lean | 64 +++++++++++++----------------------------- Proofs/SpecProofs.lean | 10 ++++--- README.md | 2 +- SPEC.md | 8 ++++-- Spec.lean | 13 ++++++--- bar.toml | 2 +- comparator.json | 2 +- tests/TEST-RESULTS.md | 11 ++++---- tests/run_tests.py | 21 ++++++++++---- 11 files changed, 70 insertions(+), 71 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index 275fe5b..5d805d1 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -176,12 +176,13 @@ def parseShares (bs : List UInt8) : /-- Read the key_share value, in the client form: a two byte list length that covers the rest of the value, then - at least one entry. -/ + the entries. The list may be empty: RFC 8446 section + 4.2.8 lets a client send no shares, to ask for a + HelloRetryRequest. -/ def parseKS (v : List UInt8) : Option Extension := getU16 v >>= fun (n, rest) => if rest.length = n then - parseShares rest >>= fun ss => - if ss.isEmpty then none else some (.keyShare ss) + parseShares rest >>= fun ss => some (.keyShare ss) else none /-- Read one extension value, by its type. The four decoded diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean index 425a582..f9ea71d 100644 --- a/ClientHello/Value.lean +++ b/ClientHello/Value.lean @@ -191,7 +191,6 @@ def ExtWF : Extension → Prop | .supportedVersions vs => vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ vs.length ≤ 127 | .keyShare ss => - ss ≠ [] ∧ (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) ∧ List.Nodup (ss.map Prod.fst) ∧ diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 6a4b0ab..39fa92e 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1151,9 +1151,8 @@ theorem parseShares_inv {bs : List UInt8} parseSharesGo_inv _ _ _ h /-- A printed key_share value reads back as the - extension. -/ + extension. The list may be empty. -/ theorem parseKS_print {ss : List (Nat × List UInt8)} - (hne : ss ≠ []) (hw : ∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) (hnodup : List.Nodup (ss.map Prod.fst)) @@ -1168,15 +1167,10 @@ theorem parseKS_print {ss : List (Nat × List UInt8)} show (if (printShares ss).length = (printShares ss).length then parseShares (printShares ss) >>= fun ss' => - if ss'.isEmpty then none else some (Extension.keyShare ss') + some (Extension.keyShare ss') else none) = some (Extension.keyShare ss) rw [if_pos rfl, parseShares_print hw hnodup] - show (if ss.isEmpty then none else some (Extension.keyShare ss)) - = some (Extension.keyShare ss) - rw [if_neg (by - cases ss with - | nil => exact absurd rfl hne - | cons s ss' => simp)] + rfl /-- A key_share value a successful read gives is the printed form of the extension it gives, and the @@ -1189,41 +1183,25 @@ theorem parseKS_inv {v : List UInt8} {e : Extension} unfold parseKS at h obtain ⟨⟨n, rest⟩, hn, h⟩ := Option.bind_eq_some_iff.mp h change (if rest.length = n then - parseShares rest >>= fun ss => - if ss.isEmpty then none else some (.keyShare ss) + parseShares rest >>= fun ss => some (.keyShare ss) else none) = some e at h obtain ⟨hrest, hnlt⟩ := getU16_inv hn by_cases hc : rest.length = n · rw [if_pos hc] at h obtain ⟨ss, hrec, h⟩ := Option.bind_eq_some_iff.mp h - by_cases hemp : ss.isEmpty = false - · rw [if_neg (by - intro hcon - rw [hcon] at hemp - simp at hemp)] at h - simp only [Option.some.injEq] at h - subst h - obtain ⟨hprint, hprops, hnodup⟩ := parseShares_inv hrec - have hne : ss ≠ [] := by - cases ss with - | nil => simp at hemp - | cons s' ss' => intro hcon; cases hcon - refine ⟨ss, rfl, ?_, ?_⟩ - · show be16 (printShares ss).length ++ - printShares ss = v - rw [hprint, hc, hrest] - · exact ⟨hne, hprops, hnodup, by - have h2 : (printShares ss).length = rest.length := by - rw [hprint] - have hvlen : v.length = rest.length + 2 := by - rw [hrest]; simp [be16] - omega⟩ - · have hemp2 : ss.isEmpty = true := by - cases h' : ss.isEmpty with - | true => rfl - | false => exact absurd h' hemp - rw [if_pos hemp2] at h - simp at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hprint, hprops, hnodup⟩ := parseShares_inv hrec + refine ⟨ss, rfl, ?_, ?_⟩ + · show be16 (printShares ss).length ++ + printShares ss = v + rw [hprint, hc, hrest] + · exact ⟨hprops, hnodup, by + have h2 : (printShares ss).length = rest.length := by + rw [hprint] + have hvlen : v.length = rest.length + 2 := by + rw [hrest]; simp [be16] + omega⟩ · rw [if_neg hc] at h simp at h @@ -1271,8 +1249,7 @@ theorem printExtValue_length_le {e : Extension} printPairs vs).length ≤ 65535 rw [List.length_cons, printPairs_length] omega - · have h' : ss ≠ [] ∧ - (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + · have h' : (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) ∧ List.Nodup (ss.map Prod.fst) ∧ (printShares ss).length ≤ 65533 := h @@ -1318,8 +1295,7 @@ theorem parseExtValue_printExtValue (e : Extension) unfold parseExtValue rw [if_neg (by decide), if_neg (by decide), if_pos rfl] exact parseSV_print h'.1 h'.2.1 h'.2.2 - · have h' : ss ≠ [] ∧ - (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + · have h' : (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) ∧ List.Nodup (ss.map Prod.fst) ∧ (printShares ss).length ≤ 65533 := h @@ -1328,7 +1304,7 @@ theorem parseExtValue_printExtValue (e : Extension) unfold parseExtValue rw [if_neg (by decide), if_neg (by decide), if_neg (by decide), if_pos rfl] - exact parseKS_print h'.1 h'.2.1 h'.2.2.1 h'.2.2.2 + exact parseKS_print h'.1 h'.2.1 h'.2.2 · have h' : ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ t < 65536 ∧ v.length ≤ 65535 := h have hn := not_or.mp h'.1 diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index bbaf935..fcccf34 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -34,6 +34,12 @@ theorem Spec.accepts_supported_versions : decide +kernel +theorem Spec.accepts_key_share_empty_list : + (parse ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8)).map print = + some ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8) := by + decide +kernel + + theorem Spec.rejects_empty : (parse ([] : List UInt8)).isSome = false := by decide +kernel @@ -124,10 +130,6 @@ theorem Spec.rejects_key_share_empty_key : decide +kernel -theorem Spec.rejects_key_share_empty_list : - (parse ([22, 3, 1, 0, 53, 1, 0, 0, 49, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 6, 0, 51, 0, 2, 0, 0] : List UInt8)).isSome = false := by - decide +kernel - theorem Spec.rejects_supported_versions_odd : (parse ([22, 3, 1, 0, 55, 1, 0, 0, 51, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 8, 0, 43, 0, 4, 3, 3, 4, 3] : List UInt8)).isSome = false := by diff --git a/README.md b/README.md index 848f7b9..7e76b66 100644 --- a/README.md +++ b/README.md @@ -47,6 +47,7 @@ where they end in `sorry`) and proved in | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | | A hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | | A minimal hello carrying only supported_versions is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | +| A TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | | Empty input is refused. | `Spec.rejects_empty` | | Input shorter than the record header is refused. | `Spec.rejects_short_header` | | A record length of 0 is refused. | `Spec.rejects_record_length_zero` | @@ -65,7 +66,6 @@ where they end in `sorry`) and proved in | An extension length running past the block is refused. | `Spec.rejects_extension_overrun` | | A key share group standing twice is refused. | `Spec.rejects_duplicate_key_share_group` | | A key share entry with empty key bytes is refused. | `Spec.rejects_key_share_empty_key` | -| A key_share value with no entries is refused. | `Spec.rejects_key_share_empty_list` | | A supported_versions value with an odd length is refused. | `Spec.rejects_supported_versions_odd` | | A supported_versions value with length 0 is refused. | `Spec.rejects_supported_versions_zero` | | An ALPN value with an empty protocol name is refused. | `Spec.rejects_alpn_empty_name` | diff --git a/SPEC.md b/SPEC.md index 71a123b..08cd01e 100644 --- a/SPEC.md +++ b/SPEC.md @@ -119,7 +119,11 @@ group, a two byte key exchange length, and that many bytes. - The list length must equal the value length minus two. -- The list must be nonempty and consume the value exactly. +- The entries must consume the value exactly. +- The list may be empty. RFC 8446 section 4.2.8 says the + client_shares vector "MAY be empty", which a client does + to ask for a HelloRetryRequest, so an empty list is + accepted. - A key exchange length of 0 rejects. - A duplicate group rejects. @@ -156,6 +160,7 @@ each rule on many more inputs. | A message the parser took prints back to the bytes it was read from, and is well formed | `Spec.print_parse` | | A present, empty extensions block is accepted | `Spec.accepts_empty_extensions` | | A minimal hello with only supported_versions is accepted | `Spec.accepts_supported_versions` | +| A TLS 1.3 hello whose key_share carries no entries, as a client asking for a HelloRetryRequest sends it, is accepted | `Spec.accepts_key_share_empty_list` | | Empty input is refused | `Spec.rejects_empty` | | Input shorter than the record header is refused | `Spec.rejects_short_header` | | A record length of 0 is refused | `Spec.rejects_record_length_zero` | @@ -174,7 +179,6 @@ each rule on many more inputs. | An extension length running past the block is refused | `Spec.rejects_extension_overrun` | | A duplicate key share group is refused | `Spec.rejects_duplicate_key_share_group` | | A key share entry with empty key bytes is refused | `Spec.rejects_key_share_empty_key` | -| A key_share value with no entries is refused | `Spec.rejects_key_share_empty_list` | | A supported_versions value with an odd length is refused | `Spec.rejects_supported_versions_odd` | | A supported_versions value with length 0 is refused | `Spec.rejects_supported_versions_zero` | | An ALPN value with an empty protocol name is refused | `Spec.rejects_alpn_empty_name` | diff --git a/Spec.lean b/Spec.lean index 428c659..029c92d 100644 --- a/Spec.lean +++ b/Spec.lean @@ -51,6 +51,15 @@ theorem Spec.accepts_supported_versions : (parse ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).map print = some ([22, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8) := sorry +/-- A TLS 1.3 hello whose key_share carries an empty client_shares list, + the form a client sends to ask for a HelloRetryRequest (RFC 8446 + section 4.2.8), is accepted and writes back as the same bytes. Besides + key_share it carries supported_groups [x25519, secp256r1], + supported_versions [0x0304] and signature_algorithms. -/ +theorem Spec.accepts_key_share_empty_list : + (parse ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8)).map print = + some ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8) := sorry + /-! ## Refused inputs Single inputs the parser refuses, one for each headline rule of @@ -130,10 +139,6 @@ theorem Spec.rejects_duplicate_key_share_group : theorem Spec.rejects_key_share_empty_key : (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 10, 0, 51, 0, 6, 0, 4, 0, 29, 0, 0] : List UInt8)).isSome = false := sorry -/-- A key_share value with no entries is refused. -/ -theorem Spec.rejects_key_share_empty_list : - (parse ([22, 3, 1, 0, 53, 1, 0, 0, 49, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 6, 0, 51, 0, 2, 0, 0] : List UInt8)).isSome = false := sorry - /-- A supported_versions value with an odd byte length is refused. -/ theorem Spec.rejects_supported_versions_odd : (parse ([22, 3, 1, 0, 55, 1, 0, 0, 51, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 8, 0, 43, 0, 4, 3, 3, 4, 3] : List UInt8)).isSome = false := sorry diff --git a/bar.toml b/bar.toml index afebc16..15eb8f1 100644 --- a/bar.toml +++ b/bar.toml @@ -7,7 +7,7 @@ name = "clienthello" status = "in-progress" page = "README.md" # GitHub handles of everyone who wrote the specification. -spec_authors = ["abu-aska"] +spec_authors = ["abu-aska", "zero-aska"] # The program people run. A change to it voids the approval. entry_points = ["Main.lean"] diff --git a/comparator.json b/comparator.json index 96381be..cf6e79d 100644 --- a/comparator.json +++ b/comparator.json @@ -6,6 +6,7 @@ "Spec.print_parse", "Spec.accepts_empty_extensions", "Spec.accepts_supported_versions", + "Spec.accepts_key_share_empty_list", "Spec.rejects_empty", "Spec.rejects_short_header", "Spec.rejects_record_length_zero", @@ -24,7 +25,6 @@ "Spec.rejects_extension_overrun", "Spec.rejects_duplicate_key_share_group", "Spec.rejects_key_share_empty_key", - "Spec.rejects_key_share_empty_list", "Spec.rejects_supported_versions_odd", "Spec.rejects_supported_versions_zero", "Spec.rejects_alpn_empty_name", diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index a647a11..fa826b2 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -1,7 +1,7 @@ # ClientHello slice: test results Run: python3 tests/run_tests.py --seed 20261026 --count 3200 -Seed: 20261026. Python 3.12.3. +Seed: 20261026. Python 3.13.17. ## Oracles @@ -13,14 +13,14 @@ Python's ssl module cannot build a ClientHello on demand. Go is not installed (` | part | run | agreed | | --- | --- | --- | -| named cases | 29 | 29 | +| named cases | 30 | 30 | | generated messages | 3200 | 3200 | | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | | malformed request lines | 7 | 7 | -| total | 4844 | 4844 | +| total | 4845 | 4845 | -Of the 3200 generated messages, the oracle accepts 1125 and rejects 2075. +Of the 3200 generated messages, the oracle accepts 1233 and rejects 1967. ## Named cases @@ -47,7 +47,8 @@ Of the 3200 generated messages, the oracle accepts 1125 and rejects 2075. - SNI list length mismatch: reject (72 bytes) - SNI empty list: reject (58 bytes) - key share empty key bytes: reject (62 bytes) -- key share empty list: reject (58 bytes) +- key share empty list, accepted: accept (58 bytes) +- TLS 1.3 hello asking for a HelloRetryRequest (supported_groups, supported_versions 0x0304, empty key_share), accepted: accept (83 bytes) - trailing garbage after the record: reject (53 bytes) - empty extensions block, length 0, accepted: accept (52 bytes) - record length zero: reject (5 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index 24c8047..48eef90 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -171,8 +171,8 @@ def oracle_ks(v): raise Reject() seen.add(group) shares.append((group, bytes(key))) - if not shares: - raise Reject() + # An empty list is allowed: RFC 8446 section 4.2.8, a + # client asking for a HelloRetryRequest sends no shares. out = be16(listlen) for group, key in shares: out += be16(group) + be16(len(key)) + key @@ -456,9 +456,18 @@ def named_cases(): cases.append(("key share empty key bytes", build_hello(exts=[(51, ks_value([(29, b"")]))]), False)) - cases.append(("key share empty list", + cases.append(("key share empty list, accepted", build_hello(exts=[(51, ks_value([]))]), - False)) + True)) + cases.append(("TLS 1.3 hello asking for a HelloRetryRequest " + "(supported_groups, supported_versions 0x0304, " + "empty key_share), accepted", + build_hello(exts=[ + (10, be16(4) + be16(29) + be16(23)), + (43, sv_value([0x0304])), + (51, ks_value([])), + (13, be16(2) + b"\x04\x03")]), + True)) cases.append(("trailing garbage after the record", build_hello(trailing=b"\x00"), False)) cases.append(("empty extensions block, length 0, accepted", @@ -528,6 +537,8 @@ def gen_ks(rng, defect): shares = [(g, bytes(rng.randrange(256) for _ in range(rng.choice([1, 32, 65])))) for g in groups] + if defect == "ks-empty-list": + shares = [] if defect == "ks-dup-group": shares.append((shares[0][0], b"\x09" * 8)) if defect == "ks-empty-key": @@ -554,7 +565,7 @@ def gen_opaque(rng, taken): "sni-second-host", "sni-dup-type", "sni-empty-host", "sni-list-len", "alpn-empty-name", "alpn-list-len", "sv-odd", "sv-zero", "sv-len-lie", "ks-dup-group", - "ks-empty-key", "ks-list-len"] + "ks-empty-key", "ks-list-len", "ks-empty-list"] def gen_message(rng): From fcf406a8026ac7a761fb82f27acb15d6616e5083 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:03:42 +0000 Subject: [PATCH 04/19] Rework the top of the parser so lean4lean accepts the round trip Review of e4c149a, blocking item 2: lean4lean rejected ClientHello.Proofs.parseBody_print with "(kernel) deep recursion detected", so lake comparator --paranoid failed (bar item 3). parse_print failed the same way once parseBody_print was set aside. Cause: the proofs relied on the kernel seeing, by unfolding, that parseBody (1 :: (be24 L ++ F)) is the getU24 step that follows. Even a bare rfl of that equation, with F a free variable, sends lean4lean into deep recursion. While it looks for the match it compares unrelated reads such as getU8 (1 :: X) and getU24 X, and so 1 against u24 arithmetic on symbolic bytes. The other five kernels give up on that branch quickly. Fix: parse, parseBody and parseBodyFields now read their fields with four continuation readers, withU8, withU16, withU24 and withBytes (Parse.lean). Each reads a field off the front of the input and calls the rest of the parser with the value and the remaining bytes. Their lemmas (withU16_be16, withU24_be24, withBytes_app, withBytes_self and the matching _inv lemmas in RoundTrip.lean) are proved once for any continuation. So every step of parseBodyFields_print, parseBody_print and parse_print is now a rewrite, and the kernel checks only beta steps and small lemmas. The inverse proofs use the _inv lemmas in the same way. getU8, getU24 and getBytes are no longer used and are removed, and bar.toml's code list names the new readers. The parser accepts and refuses exactly the same inputs as before: the test run gives the same 4,845 inputs and 0 failures, and TEST-RESULTS.md is unchanged. lake comparator --paranoid now passes: Lean's kernel, leanchecker-paranoid, lean4lean, nanoda, con-leche and con-ron all accept the 29 theorems. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 107 ++++--- Proofs/RoundTrip.lean | 671 ++++++++++++++++++----------------------- bar.toml | 4 +- 3 files changed, 369 insertions(+), 413 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index 5d805d1..67738da 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -42,28 +42,51 @@ import ClientHello.Value namespace ClientHello -/-- Read one byte as a value, with the rest of the input. -/ -def getU8 : List UInt8 → Option (Nat × List UInt8) - | b :: rest => some (b.toNat, rest) - | [] => none - /-- Read two bytes as a big endian value, with the rest of the input. Fewer than two bytes gives `none`. -/ def getU16 : List UInt8 → Option (Nat × List UInt8) | a :: b :: rest => some (u16 a b, rest) | _ => none -/-- Read three bytes as a big endian value, with the rest of - the input. Fewer than three bytes gives `none`. -/ -def getU24 : List UInt8 → Option (Nat × List UInt8) - | a :: b :: c :: rest => some (u24 a b c, rest) +/-! The record, the handshake header and the body fields are +read with the four readers below. Each one reads a field off +the front of the input and goes on with the field's value +and the rest of the input, or gives `none` when the input is +too short. Writing the top of the parser this way keeps each +proof step a rewrite with one of the reader lemmas, which +every kernel bundled with Lean checks quickly. -/ + +/-- Read one byte, then go on with its value and the rest of + the input. No byte gives `none`. -/ +def withU8 {α : Type} (bs : List UInt8) + (k : Nat → List UInt8 → Option α) : Option α := + match bs with + | b :: rest => k b.toNat rest + | [] => none + +/-- Read two bytes as a big endian value, then go on with the + value and the rest of the input. Fewer than two bytes give + `none`. -/ +def withU16 {α : Type} (bs : List UInt8) + (k : Nat → List UInt8 → Option α) : Option α := + match bs with + | a :: b :: rest => k (u16 a b) rest + | _ => none + +/-- Read three bytes as a big endian value, then go on with + the value and the rest of the input. Fewer than three bytes + give `none`. -/ +def withU24 {α : Type} (bs : List UInt8) + (k : Nat → List UInt8 → Option α) : Option α := + match bs with + | a :: b :: c :: rest => k (u24 a b c) rest | _ => none -/-- Read `n` bytes as a block, with the rest of the input. - Fewer than `n` bytes gives `none`. -/ -def getBytes (n : Nat) (bs : List UInt8) : - Option (List UInt8 × List UInt8) := - if (bs.take n).length = n then some (bs.take n, bs.drop n) +/-- Read `n` bytes as a block, then go on with the block and + the rest of the input. Fewer than `n` bytes give `none`. -/ +def withBytes {α : Type} (n : Nat) (bs : List UInt8) + (k : List UInt8 → List UInt8 → Option α) : Option α := + if (bs.take n).length = n then k (bs.take n) (bs.drop n) else none /-- Read a list of two byte values from bytes that must be @@ -223,24 +246,27 @@ def parseExts (bs : List UInt8) : Option (List Extension) := suites, compression methods, and the extensions block, which must be present and must run to the end. -/ def parseBodyFields (bs : List UInt8) : Option Hello := - getU16 bs >>= fun (ver, r1) => - getBytes 32 r1 >>= fun (rand, r2) => - getU8 r2 >>= fun (slen, r3) => - (if slen ≤ 32 then getBytes slen r3 else none) >>= - fun (sess, r4) => - getU16 r4 >>= fun (clen, r5) => - (if clen % 2 = 0 ∧ 2 ≤ clen then getBytes clen r5 - else none) >>= fun (cbytes, r6) => - parsePairs cbytes >>= fun suites => - getU8 r6 >>= fun (mlen, r7) => - (if 1 ≤ mlen then getBytes mlen r7 else none) >>= - fun (comps, r8) => - if (0 : UInt8) ∈ comps then - getU16 r8 >>= fun (elen, r9) => - getBytes elen r9 >>= fun (ebytes, r10) => - if r10 = [] then - parseExts ebytes >>= fun exts => - some ⟨ver, rand, sess, suites, comps, exts⟩ + withU16 bs fun ver r1 => + withBytes 32 r1 fun rand r2 => + withU8 r2 fun slen r3 => + if slen ≤ 32 then + withBytes slen r3 fun sess r4 => + withU16 r4 fun clen r5 => + if clen % 2 = 0 ∧ 2 ≤ clen then + withBytes clen r5 fun cbytes r6 => + (parsePairs cbytes).bind fun suites => + withU8 r6 fun mlen r7 => + if 1 ≤ mlen then + withBytes mlen r7 fun comps r8 => + if (0 : UInt8) ∈ comps then + withU16 r8 fun elen r9 => + withBytes elen r9 fun ebytes r10 => + if r10 = [] then + (parseExts ebytes).map fun exts => + ⟨ver, rand, sess, suites, comps, exts⟩ + else none + else none + else none else none else none @@ -248,23 +274,22 @@ def parseBodyFields (bs : List UInt8) : Option Hello := byte must be 1, and the three byte length must cover the rest of the body exactly. -/ def parseBody (body : List UInt8) : Option Hello := - getU8 body >>= fun (htype, r1) => + withU8 body fun htype r1 => if htype = 1 then - getU24 r1 >>= fun (hlen, r2) => - getBytes hlen r2 >>= fun (fbs, r3) => + withU24 r1 fun hlen r2 => + withBytes hlen r2 fun fbs r3 => if r3 = [] then parseBodyFields fbs else none else none /-- Parse a whole message: one record, holding one ClientHello, with no bytes after the record. -/ def parse (bs : List UInt8) : Option Message := - getU8 bs >>= fun (ct, r1) => + withU8 bs fun ct r1 => if ct = 22 then - getU16 r1 >>= fun (rv, r2) => - getU16 r2 >>= fun (rlen, r3) => - getBytes rlen r3 >>= fun (body, r4) => - if r4 = [] then - (parseBody body).map (fun h => ⟨rv, h⟩) + withU16 r1 fun rv r2 => + withU16 r2 fun rlen r3 => + withBytes rlen r3 fun body r4 => + if r4 = [] then (parseBody body).map fun h => ⟨rv, h⟩ else none else none diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 39fa92e..8e62776 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -89,10 +89,6 @@ theorem be24_u24 (a b c : UInt8) : /-! ## The readers, on printed forms and on read forms -/ -/-- One step of the one byte reader, stated for rewriting. -/ -theorem getU8_cons (b : UInt8) (r : List UInt8) : - getU8 (b :: r) = some (b.toNat, r) := rfl - /-- Reading two bytes off the front of a printed value and what follows it. -/ theorem getU16_be16 (n : Nat) (h : n < 65536) (r : List UInt8) : @@ -101,41 +97,6 @@ theorem getU16_be16 (n : Nat) (h : n < 65536) (r : List UInt8) : show some (u16 (n / 256).toUInt8 n.toUInt8, r) = some (n, r) rw [u16_be16 n h] -/-- Reading three bytes off the front of a printed value and - what follows it. -/ -theorem getU24_be24 (n : Nat) (h : n < 16777216) - (r : List UInt8) : - getU24 (be24 n ++ r) = some (n, r) := by - show getU24 ((n / 65536).toUInt8 :: (n / 256).toUInt8 :: - n.toUInt8 :: r) = some (n, r) - show some (u24 (n / 65536).toUInt8 (n / 256).toUInt8 - n.toUInt8, r) = some (n, r) - rw [u24_be24 n h] - -/-- Reading a byte block off the front of a printed block and - what follows it. -/ -theorem getBytes_app {n : Nat} {v : List UInt8} (hv : v.length = n) - (r : List UInt8) : getBytes n (v ++ r) = some (v, r) := by - unfold getBytes - have ht : (v ++ r).take n = v := by - rw [← hv]; exact List.take_left - have hd : (v ++ r).drop n = r := by - rw [← hv]; exact List.drop_left - rw [ht, hd, if_pos hv] - -/-- A byte read by the one byte reader prints back as that - byte: the input was the byte and the rest. -/ -theorem getU8_inv {bs : List UInt8} {n : Nat} {r : List UInt8} - (h : getU8 bs = some (n, r)) : bs = n.toUInt8 :: r := by - cases bs with - | nil => simp [getU8] at h - | cons b r' => - have hstep : getU8 (b :: r') = some (b.toNat, r') := rfl - rw [hstep] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h - obtain ⟨rfl, rfl⟩ := h - rw [toNat_toUInt8] - /-- Bytes read by the two byte reader print back as those bytes, and the value fits two bytes. -/ theorem getU16_inv {bs : List UInt8} {n : Nat} {r : List UInt8} @@ -157,46 +118,160 @@ theorem getU16_inv {bs : List UInt8} {n : Nat} {r : List UInt8} have hb := toNat_lt b simp only [u16]; omega -/-- Bytes read by the three byte reader print back as those - bytes, and the value fits three bytes. -/ -theorem getU24_inv {bs : List UInt8} {n : Nat} {r : List UInt8} - (h : getU24 bs = some (n, r)) : - bs = be24 n ++ r ∧ n < 16777216 := by +/-! The continuation readers. Each lemma below is stated for +any continuation `k`, so a proof uses it by rewriting: the +continuation in the goal is matched as it stands, and what is +left is its body, applied to the field read. -/ + +/-- A printed two byte value, as its two bytes in front of + what follows it. -/ +theorem be16_append (n : Nat) (r : List UInt8) : + be16 n ++ r = (n / 256).toUInt8 :: n.toUInt8 :: r := rfl + +/-- A printed three byte value, as its three bytes in front + of what follows it. -/ +theorem be24_append (n : Nat) (r : List UInt8) : + be24 n ++ r = + (n / 65536).toUInt8 :: (n / 256).toUInt8 :: n.toUInt8 :: r := + rfl + +/-- One step of the one byte reader. -/ +theorem withU8_cons {α : Type} (b : UInt8) (r : List UInt8) + (k : Nat → List UInt8 → Option α) : + withU8 (b :: r) k = k b.toNat r := rfl + +/-- One step of the two byte reader. -/ +theorem withU16_cons {α : Type} (a b : UInt8) (r : List UInt8) + (k : Nat → List UInt8 → Option α) : + withU16 (a :: b :: r) k = k (u16 a b) r := rfl + +/-- One step of the three byte reader. -/ +theorem withU24_cons {α : Type} (a b c : UInt8) (r : List UInt8) + (k : Nat → List UInt8 → Option α) : + withU24 (a :: b :: c :: r) k = k (u24 a b c) r := rfl + +/-- The two byte reader on a printed value reads the value. -/ +theorem withU16_be16 {α : Type} {n : Nat} (h : n < 65536) + (r : List UInt8) (k : Nat → List UInt8 → Option α) : + withU16 (be16 n ++ r) k = k n r := by + rw [be16_append, withU16_cons, u16_be16 n h] + +/-- The three byte reader on a printed value reads the + value. -/ +theorem withU24_be24 {α : Type} {n : Nat} (h : n < 16777216) + (r : List UInt8) (k : Nat → List UInt8 → Option α) : + withU24 (be24 n ++ r) k = k n r := by + rw [be24_append, withU24_cons, u24_be24 n h] + +/-- The block reader on a block of the length it asks for + reads the block. -/ +theorem withBytes_app {α : Type} {n : Nat} {v : List UInt8} + (hv : v.length = n) (r : List UInt8) + (k : List UInt8 → List UInt8 → Option α) : + withBytes n (v ++ r) k = k v r := by + unfold withBytes + have ht : (v ++ r).take n = v := by + rw [← hv]; exact List.take_left + have hd : (v ++ r).drop n = r := by + rw [← hv]; exact List.drop_left + rw [ht, hd, if_pos hv] + +/-- A block read at exactly its own length gives the block + and nothing after it. -/ +theorem withBytes_self {α : Type} (bs : List UInt8) + (k : List UInt8 → List UInt8 → Option α) : + withBytes bs.length bs k = k bs [] := by + have h := withBytes_app (v := bs) rfl [] k + rw [List.append_nil] at h + exact h + +/-- A successful one byte read: the input was the byte and + the rest, and the value fits a byte. -/ +theorem withU8_inv {α : Type} {bs : List UInt8} + {k : Nat → List UInt8 → Option α} {x : α} + (h : withU8 bs k = some x) : + ∃ n r, bs = n.toUInt8 :: r ∧ n < 256 ∧ k n r = some x := by + cases bs with + | nil => + have h0 : withU8 ([] : List UInt8) k = none := rfl + rw [h0] at h + cases h + | cons b r => + rw [withU8_cons] at h + exact ⟨b.toNat, r, by rw [toNat_toUInt8], toNat_lt b, h⟩ + +/-- A successful two byte read: the input was the printed + value and the rest, and the value fits two bytes. -/ +theorem withU16_inv {α : Type} {bs : List UInt8} + {k : Nat → List UInt8 → Option α} {x : α} + (h : withU16 bs k = some x) : + ∃ n r, bs = be16 n ++ r ∧ n < 65536 ∧ k n r = some x := by cases bs with - | nil => simp [getU24] at h + | nil => + have h0 : withU16 ([] : List UInt8) k = none := rfl + rw [h0] at h + cases h | cons a bs' => cases bs' with - | nil => simp [getU24] at h + | nil => + have h0 : withU16 [a] k = none := rfl + rw [h0] at h + cases h + | cons b r => + rw [withU16_cons] at h + refine ⟨u16 a b, r, ?_, ?_, h⟩ + · rw [be16_u16] + rfl + · have ha := toNat_lt a + have hb := toNat_lt b + simp only [u16]; omega + +/-- A successful three byte read: the input was the printed + value and the rest, and the value fits three bytes. -/ +theorem withU24_inv {α : Type} {bs : List UInt8} + {k : Nat → List UInt8 → Option α} {x : α} + (h : withU24 bs k = some x) : + ∃ n r, bs = be24 n ++ r ∧ n < 16777216 ∧ k n r = some x := by + cases bs with + | nil => + have h0 : withU24 ([] : List UInt8) k = none := rfl + rw [h0] at h + cases h + | cons a bs' => + cases bs' with + | nil => + have h0 : withU24 [a] k = none := rfl + rw [h0] at h + cases h | cons b bs'' => cases bs'' with - | nil => simp [getU24] at h - | cons c r' => - have hstep : getU24 (a :: b :: c :: r') - = some (u24 a b c, r') := rfl - rw [hstep] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h - obtain ⟨rfl, rfl⟩ := h - refine ⟨?_, ?_⟩ - · simp only [be24_u24, List.cons_append, List.nil_append] + | nil => + have h0 : withU24 [a, b] k = none := rfl + rw [h0] at h + cases h + | cons c r => + rw [withU24_cons] at h + refine ⟨u24 a b c, r, ?_, ?_, h⟩ + · rw [be24_u24] + rfl · have ha := toNat_lt a have hb := toNat_lt b have hc := toNat_lt c simp only [u24]; omega -/-- A block read by the block reader is its first `n` bytes, - and the rest is the rest: the input was the block and the - rest, and the block holds `n` bytes. -/ -theorem getBytes_inv {n : Nat} {bs v : List UInt8} - {r : List UInt8} (h : getBytes n bs = some (v, r)) : - v.length = n ∧ bs = v ++ r := by - unfold getBytes at h +/-- A successful block read: the block holds `n` bytes, and + the input was the block and the rest. -/ +theorem withBytes_inv {α : Type} {n : Nat} {bs : List UInt8} + {k : List UInt8 → List UInt8 → Option α} {x : α} + (h : withBytes n bs k = some x) : + ∃ v r, v.length = n ∧ bs = v ++ r ∧ k v r = some x := by + unfold withBytes at h by_cases hc : (bs.take n).length = n · rw [if_pos hc] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h - obtain ⟨rfl, rfl⟩ := h - exact ⟨hc, (List.take_append_drop n bs).symm⟩ + exact ⟨bs.take n, bs.drop n, hc, + (List.take_append_drop n bs).symm, h⟩ · rw [if_neg hc] at h - simp at h + cases h /-! ## Two byte value lists: the cipher suites and the supported versions -/ @@ -1609,30 +1684,22 @@ theorem parseExts_inv {bs : List UInt8} List.Nodup (es.map extType) := parseExtsGo_inv _ _ _ h -/-- The value a successful one byte read gives fits in a - byte. -/ -theorem getU8_lt {bs : List UInt8} {n : Nat} {r : List UInt8} - (h : getU8 bs = some (n, r)) : n < 256 := by - cases bs with - | nil => simp [getU8] at h - | cons b r' => - have hstep : getU8 (b :: r') = some (b.toNat, r') := rfl - rw [hstep] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h - obtain ⟨rfl, rfl⟩ := h - exact toNat_lt b - -/-- A block read at exactly its own length gives the block - and nothing after it. -/ -theorem getBytes_self (bs : List UInt8) : - getBytes bs.length bs = some (bs, []) := by - unfold getBytes - have ht : bs.take bs.length = bs := List.take_length - have hd : bs.drop bs.length = [] := List.drop_length - rw [ht, hd, if_pos rfl] - /-! ## The body fields -/ +/-- The printed body fields, with each field in front of the + rest, in the shape the readers take them apart. -/ +theorem printBodyFields_eq (h : Hello) : + printBodyFields h = + be16 h.legacyVersion ++ (h.random ++ + (h.sessionId.length.toUInt8 :: (h.sessionId ++ + (be16 (printPairs h.cipherSuites).length ++ + (printPairs h.cipherSuites ++ + (h.compressionMethods.length.toUInt8 :: + (h.compressionMethods ++ + (be16 (printExts h.extensions).length ++ + printExts h.extensions)))))))) := by + simp only [printBodyFields, List.append_assoc, List.cons_append] + /-- The printed body fields read back as the hello. -/ theorem parseBodyFields_print (m : Message) (hw : WF m) : parseBodyFields (printBodyFields m.hello) = some m.hello := by @@ -1655,45 +1722,19 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : = m.hello.compressionMethods.length := by rw [toUInt8_toNat] exact Nat.mod_eq_of_lt (by omega) + have hpl := printPairs_length m.hello.cipherSuites have hguard : (printPairs m.hello.cipherSuites).length % 2 = 0 ∧ - 2 ≤ (printPairs m.hello.cipherSuites).length := by - have h2 := printPairs_length m.hello.cipherSuites - exact ⟨by omega, by omega⟩ - unfold parseBodyFields printBodyFields - simp only [List.append_assoc] - rw [getU16_be16 _ hver] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getBytes_app hrand] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [List.cons_append, getU8_cons] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [hsb, if_pos hsess, getBytes_app rfl] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getU16_be16 _ (by - have h2 := printPairs_length m.hello.cipherSuites - omega)] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [if_pos hguard, getBytes_app rfl] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [parsePairs_printPairs hsuites_lt] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [List.cons_append, getU8_cons] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [hcb, if_pos hcomp_len1, getBytes_app rfl] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [if_pos hcomp0, - getU16_be16 _ (by omega)] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getBytes_self] - simp only [Option.bind_eq_bind, Option.bind_some] - show (parseExts (printExts m.hello.extensions) >>= fun exts => - some ⟨m.hello.legacyVersion, m.hello.random, - m.hello.sessionId, m.hello.cipherSuites, - m.hello.compressionMethods, exts⟩) = some m.hello - rw [parseExts_print hext_wf hnodup] - simp only [Option.bind_eq_bind, Option.bind_some] - - + 2 ≤ (printPairs m.hello.cipherSuites).length := + ⟨by omega, by omega⟩ + rw [printBodyFields_eq] + unfold parseBodyFields + rw [withU16_be16 hver, withBytes_app hrand, withU8_cons, hsb, + if_pos hsess, withBytes_app rfl, withU16_be16 (by omega), + if_pos hguard, withBytes_app rfl, + parsePairs_printPairs hsuites_lt, Option.bind_some, + withU8_cons, hcb, if_pos hcomp_len1, withBytes_app rfl, + if_pos hcomp0, withU16_be16 (by omega), withBytes_self, + if_pos rfl, parseExts_print hext_wf hnodup, Option.map_some] /-- A parsed hello prints back to the input bytes, and every field satisfies the well formedness bounds. -/ @@ -1712,141 +1753,74 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} List.Nodup (h.extensions.map extType) ∧ (printExts h.extensions).length ≤ 65535 := by unfold parseBodyFields at hparse - simp only [Option.bind_eq_bind] at hparse - obtain ⟨⟨ver, r1⟩, s1, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨rand, r2⟩, s2, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨slen, r3⟩, s3, hparse⟩ := - Option.bind_eq_some_iff.mp hparse + obtain ⟨ver, r1, hbs, hver, hp⟩ := withU16_inv hparse + obtain ⟨rand, r2, hrand, hr1, hp⟩ := withBytes_inv hp + obtain ⟨slen, r3, hr2, _, hp⟩ := withU8_inv hp by_cases hs : slen ≤ 32 - · rw [if_pos hs] at hparse - obtain ⟨⟨sess, r4⟩, s4, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨clen, r5⟩, s5, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases hg : clen % 2 = 0 ∧ 2 ≤ clen - · rw [if_pos hg] at hparse - obtain ⟨⟨cbytes, r6⟩, s6, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨suites, s7, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨mlen, r7⟩, s8, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases hm : 1 ≤ mlen - · rw [if_pos hm] at hparse - obtain ⟨⟨comps, r8⟩, s9, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases h0 : (0 : UInt8) ∈ comps - · rw [if_pos h0] at hparse - obtain ⟨⟨elen, r9⟩, s10, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨ebytes, r10⟩, s11, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases hr : r10 = [] - · rw [if_pos hr] at hparse - obtain ⟨exts, s12, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - rw [Option.some.injEq] at hparse - subst hparse - have hbs : bs = be16 ver ++ r1 := - (getU16_inv s1).1 - have hver : ver < 65536 := (getU16_inv s1).2 - have hrand : rand.length = 32 := - (getBytes_inv s2).1 - have hr1 : r1 = rand ++ r2 := - (getBytes_inv s2).2 - have hr2 : r2 = slen.toUInt8 :: r3 := - getU8_inv s3 - have hsesslen : sess.length = slen := - (getBytes_inv s4).1 - have hr3 : r3 = sess ++ r4 := - (getBytes_inv s4).2 - have hr4 : r4 = be16 clen ++ r5 := - (getU16_inv s5).1 - have hclen_lt : clen < 65536 := - (getU16_inv s5).2 - have hcbyteslen : cbytes.length = clen := - (getBytes_inv s6).1 - have hr5 : r5 = cbytes ++ r6 := - (getBytes_inv s6).2 - have hpp : printPairs suites = cbytes := - (parsePairs_inv s7).1 - have hsuites_lt : ∀ v ∈ suites, v < 65536 := - (parsePairs_inv s7).2 - have hplen : cbytes.length - = 2 * suites.length := - parsePairs_length s7 - have hr6 : r6 = mlen.toUInt8 :: r7 := - getU8_inv s8 - have hmlen_lt : mlen < 256 := getU8_lt s8 - have hcomplen : comps.length = mlen := - (getBytes_inv s9).1 - have hr7 : r7 = comps ++ r8 := - (getBytes_inv s9).2 - have hr8 : r8 = be16 elen ++ r9 := - (getU16_inv s10).1 - have helen_lt : elen < 65536 := - (getU16_inv s10).2 - have hebyteslen : ebytes.length = elen := - (getBytes_inv s11).1 - have hr9 : r9 = ebytes ++ r10 := - (getBytes_inv s11).2 - have hpe : printExts exts = ebytes := - (parseExts_inv s12).1 - have hext_wf : ∀ e ∈ exts, ExtWF e := - (parseExts_inv s12).2.1 - have hnodup : (exts.map extType).Nodup := - (parseExts_inv s12).2.2 - have hsess_le : sess.length ≤ 32 := by omega - have hsuites_ne : suites ≠ [] := by - intro hcon - rw [hcon] at hplen - simp at hplen - have hz : cbytes.length = 0 := by - simp [hplen] - omega - have hsuites_len : suites.length ≤ 32767 := by - omega - have hcomp_ne : comps ≠ [] := by - intro hcon - rw [hcon] at hcomplen - simp at hcomplen - omega - have hcomp_len : comps.length ≤ 255 := by - omega - have hext_len : (printExts exts).length - ≤ 65535 := by - rw [hpe, hebyteslen] - omega - have hprint : printBodyFields - ⟨ver, rand, sess, suites, comps, exts⟩ - = bs := by - show (be16 ver ++ rand ++ - (sess.length.toUInt8 :: sess) ++ - (be16 (printPairs suites).length ++ - printPairs suites) ++ - (comps.length.toUInt8 :: comps) ++ - (be16 (printExts exts).length ++ - printExts exts)) = bs - rw [hsesslen, hcomplen, hpp, hcbyteslen, - hpe, hebyteslen, hbs, hr1, hr2, hr3, hr4, - hr5, hr6, hr7, hr8, hr9, hr] - simp only [List.append_assoc, List.cons_append, - List.append_nil] - exact ⟨hprint, hver, hrand, hsess_le, - hsuites_ne, hsuites_lt, hsuites_len, hcomp_ne, - h0, hcomp_len, hext_wf, hnodup, hext_len⟩ - · rw [if_neg hr] at hparse - simp at hparse - · rw [if_neg h0] at hparse - simp at hparse - · rw [if_neg hm] at hparse - simp at hparse - · rw [if_neg hg] at hparse - simp at hparse - · rw [if_neg hs] at hparse - simp at hparse + case neg => rw [if_neg hs] at hp; cases hp + rw [if_pos hs] at hp + obtain ⟨sess, r4, hsesslen, hr3, hp⟩ := withBytes_inv hp + obtain ⟨clen, r5, hr4, hclen_lt, hp⟩ := withU16_inv hp + by_cases hg : clen % 2 = 0 ∧ 2 ≤ clen + case neg => rw [if_neg hg] at hp; cases hp + rw [if_pos hg] at hp + obtain ⟨cbytes, r6, hcbyteslen, hr5, hp⟩ := withBytes_inv hp + obtain ⟨suites, s7, hp⟩ := Option.bind_eq_some_iff.mp hp + obtain ⟨mlen, r7, hr6, hmlen_lt, hp⟩ := withU8_inv hp + by_cases hm : 1 ≤ mlen + case neg => rw [if_neg hm] at hp; cases hp + rw [if_pos hm] at hp + obtain ⟨comps, r8, hcomplen, hr7, hp⟩ := withBytes_inv hp + by_cases h0 : (0 : UInt8) ∈ comps + case neg => rw [if_neg h0] at hp; cases hp + rw [if_pos h0] at hp + obtain ⟨elen, r9, hr8, helen_lt, hp⟩ := withU16_inv hp + obtain ⟨ebytes, r10, hebyteslen, hr9, hp⟩ := withBytes_inv hp + by_cases hr : r10 = [] + case neg => rw [if_neg hr] at hp; cases hp + rw [if_pos hr] at hp + obtain ⟨exts, s12, hp⟩ := Option.map_eq_some_iff.mp hp + subst hp + have hpp : printPairs suites = cbytes := (parsePairs_inv s7).1 + have hsuites_lt : ∀ v ∈ suites, v < 65536 := + (parsePairs_inv s7).2 + have hplen : cbytes.length = 2 * suites.length := + parsePairs_length s7 + have hpe : printExts exts = ebytes := (parseExts_inv s12).1 + have hext_wf : ∀ e ∈ exts, ExtWF e := (parseExts_inv s12).2.1 + have hnodup : (exts.map extType).Nodup := + (parseExts_inv s12).2.2 + have hsess_le : sess.length ≤ 32 := by omega + have hsuites_ne : suites ≠ [] := by + intro hcon + rw [hcon, List.length_nil] at hplen + omega + have hsuites_len : suites.length ≤ 32767 := by omega + have hcomp_ne : comps ≠ [] := by + intro hcon + rw [hcon] at hcomplen + simp at hcomplen + omega + have hcomp_len : comps.length ≤ 255 := by omega + have hext_len : (printExts exts).length ≤ 65535 := by + rw [hpe, hebyteslen] + omega + have hprint : printBodyFields + ⟨ver, rand, sess, suites, comps, exts⟩ = bs := by + rw [printBodyFields_eq] + show be16 ver ++ (rand ++ + (sess.length.toUInt8 :: (sess ++ + (be16 (printPairs suites).length ++ + (printPairs suites ++ + (comps.length.toUInt8 :: (comps ++ + (be16 (printExts exts).length ++ + printExts exts)))))))) = bs + rw [hsesslen, hcomplen, hpp, hcbyteslen, hpe, hebyteslen, + hbs, hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr, + List.append_nil] + exact ⟨hprint, hver, hrand, hsess_le, hsuites_ne, hsuites_lt, + hsuites_len, hcomp_ne, h0, hcomp_len, hext_wf, hnodup, + hext_len⟩ /-! ## The handshake message and the record -/ @@ -1856,20 +1830,23 @@ theorem printBody_length (h : Hello) : (printBody h).length = (printBodyFields h).length + 4 := by simp [printBody, be24] +/-- The printed handshake message, as its type byte in front + of the rest. -/ +theorem printBody_eq (h : Hello) : + printBody h = (1 : UInt8) :: + (be24 (printBodyFields h).length ++ printBodyFields h) := + rfl + /-- The printed handshake message reads back as the hello. -/ theorem parseBody_print (m : Message) (hw : WF m) : parseBody (printBody m.hello) = some m.hello := by have hwf : WF m := hw obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hflen⟩ := hw - unfold parseBody printBody - rw [getU8_cons] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [if_pos (by decide : ((1 : UInt8).toNat = 1)), - getU24_be24 _ (by omega)] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getBytes_self] - simp only [Option.bind_eq_bind, Option.bind_some] + rw [printBody_eq] + unfold parseBody + rw [withU8_cons, if_pos (by decide : ((1 : UInt8).toNat = 1)), + withU24_be24 (by omega), withBytes_self, if_pos rfl] exact parseBodyFields_print m hwf /-- A parsed handshake message prints back to the input @@ -1889,38 +1866,30 @@ theorem parseBody_inv {body : List UInt8} {h : Hello} List.Nodup (h.extensions.map extType) ∧ (printExts h.extensions).length ≤ 65535 := by unfold parseBody at hparse - simp only [Option.bind_eq_bind] at hparse - obtain ⟨⟨htype, r1⟩, s1, hparse⟩ := - Option.bind_eq_some_iff.mp hparse + obtain ⟨htype, r1, hbody1, _, hp⟩ := withU8_inv hparse by_cases ht : htype = 1 - · rw [if_pos ht] at hparse - obtain ⟨⟨hlen, r2⟩, s2, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨fbs, r3⟩, s3, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases hr : r3 = [] - · rw [if_pos hr] at hparse - have hfi := parseBodyFields_inv hparse - have hbody1 : body = htype.toUInt8 :: r1 := - getU8_inv s1 - have hbyte : htype.toUInt8 = (1 : UInt8) := by - rw [ht] - decide - have hr1 : r1 = be24 hlen ++ r2 := - (getU24_inv s2).1 - have hfbs : fbs.length = hlen := - (getBytes_inv s3).1 - have hr2 : r2 = fbs ++ r3 := (getBytes_inv s3).2 - have hprint : printBody h = body := by - show ((1 : UInt8) :: (be24 (printBodyFields h).length - ++ printBodyFields h)) = body - rw [hfi.1, hfbs, hbody1, hbyte, hr1, hr2, hr] - simp only [List.append_nil] - exact ⟨hprint, hfi.2⟩ - · rw [if_neg hr] at hparse - simp at hparse - · rw [if_neg ht] at hparse - simp at hparse + case neg => rw [if_neg ht] at hp; cases hp + rw [if_pos ht] at hp + obtain ⟨hlen, r2, hr1, _, hp⟩ := withU24_inv hp + obtain ⟨fbs, r3, hfbs, hr2, hp⟩ := withBytes_inv hp + by_cases hr : r3 = [] + case neg => rw [if_neg hr] at hp; cases hp + rw [if_pos hr] at hp + have hfi := parseBodyFields_inv hp + have hbyte : htype.toUInt8 = (1 : UInt8) := by + rw [ht] + decide + have hprint : printBody h = body := by + rw [printBody_eq, hfi.1, hfbs, hbody1, hbyte, hr1, hr2, hr, + List.append_nil] + exact ⟨hprint, hfi.2⟩ + +/-- The whole printed message, as its content type byte in + front of the rest. -/ +theorem print_eq (m : Message) : + print m = (22 : UInt8) :: (be16 m.recordVersion ++ + (be16 (printBody m.hello).length ++ printBody m.hello)) := + rfl /-- The whole printed message reads back as the message. -/ theorem parse_print (m : Message) (hw : WF m) : @@ -1931,20 +1900,11 @@ theorem parse_print (m : Message) (hw : WF m) : have hblt : (printBody m.hello).length < 65536 := by rw [printBody_length] omega - unfold parse print - rw [getU8_cons] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [if_pos (by decide : ((22 : UInt8).toNat = 22)), - getU16_be16 _ hrv] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getU16_be16 _ hblt] - simp only [Option.bind_eq_bind, Option.bind_some] - rw [getBytes_self] - simp only [Option.bind_eq_bind, Option.bind_some] - show (Option.map (fun h => ⟨m.recordVersion, h⟩) - (parseBody (printBody m.hello))) = some m - rw [parseBody_print m hwf] - simp only [Option.map_some] + rw [print_eq] + unfold parse + rw [withU8_cons, if_pos (by decide : ((22 : UInt8).toNat = 22)), + withU16_be16 hrv, withU16_be16 hblt, withBytes_self, + if_pos rfl, parseBody_print m hwf, Option.map_some] /-- A parsed message prints back to the input bytes, and the message is well formed. -/ @@ -1952,61 +1912,32 @@ theorem print_parse {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : print m = bs ∧ WF m := by unfold parse at hparse - simp only [Option.bind_eq_bind] at hparse - obtain ⟨⟨ct, r1⟩, s1, hparse⟩ := - Option.bind_eq_some_iff.mp hparse + obtain ⟨ct, r1, hbs1, _, hp⟩ := withU8_inv hparse by_cases hct : ct = 22 - · rw [if_pos hct] at hparse - obtain ⟨⟨rv, r2⟩, s2, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨rlen, r3⟩, s3, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - obtain ⟨⟨body, r4⟩, s4, hparse⟩ := - Option.bind_eq_some_iff.mp hparse - by_cases hr : r4 = [] - · rw [if_pos hr] at hparse - cases hpb : parseBody body with - | none => - rw [hpb] at hparse - simp at hparse - | some hh => - rw [hpb] at hparse - simp only [Option.map_some, Option.some.injEq] - at hparse - subst hparse - obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, - hslen, hcne, hc0, hclen, hewf, hnod, helen⟩ := - parseBody_inv hpb - have hbs1 : bs = ct.toUInt8 :: r1 := getU8_inv s1 - have hctb : ct.toUInt8 = (22 : UInt8) := by - rw [hct] - decide - have hr1 : r1 = be16 rv ++ r2 := - (getU16_inv s2).1 - have hrv : rv < 65536 := (getU16_inv s2).2 - have hr2 : r2 = be16 rlen ++ r3 := - (getU16_inv s3).1 - have hrlen : rlen < 65536 := (getU16_inv s3).2 - have hbodylen : body.length = rlen := - (getBytes_inv s4).1 - have hr3 : r3 = body ++ r4 := - (getBytes_inv s4).2 - have hflen : (printBodyFields hh).length - ≤ 65531 := by - have h1 := printBody_length hh - rw [hbody_eq] at h1 - omega - have hprint : print ⟨rv, hh⟩ = bs := by - show ((22 : UInt8) :: (be16 rv ++ - (be16 (printBody hh).length ++ printBody hh))) - = bs - rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, - hr3, hr] - simp only [List.append_nil] - exact ⟨hprint, hrv, hver, hrand, hsess, hsne, - hslt, hslen, hcne, hc0, hclen, hewf, hnod, helen, - hflen⟩ - · rw [if_neg hr] at hparse - simp at hparse - · rw [if_neg hct] at hparse - simp at hparse + case neg => rw [if_neg hct] at hp; cases hp + rw [if_pos hct] at hp + obtain ⟨rv, r2, hr1, hrv, hp⟩ := withU16_inv hp + obtain ⟨rlen, r3, hr2, hrlen, hp⟩ := withU16_inv hp + obtain ⟨body, r4, hbodylen, hr3, hp⟩ := withBytes_inv hp + by_cases hr : r4 = [] + case neg => rw [if_neg hr] at hp; cases hp + rw [if_pos hr] at hp + obtain ⟨hh, hpb, hp⟩ := Option.map_eq_some_iff.mp hp + subst hp + obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, hslen, hcne, + hc0, hclen, hewf, hnod, helen⟩ := parseBody_inv hpb + have hctb : ct.toUInt8 = (22 : UInt8) := by + rw [hct] + decide + have hflen : (printBodyFields hh).length ≤ 65531 := by + have h1 := printBody_length hh + rw [hbody_eq] at h1 + omega + have hprint : print ⟨rv, hh⟩ = bs := by + rw [print_eq] + show (22 : UInt8) :: (be16 rv ++ + (be16 (printBody hh).length ++ printBody hh)) = bs + rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, hr3, hr, + List.append_nil] + exact ⟨hprint, hrv, hver, hrand, hsess, hsne, hslt, hslen, + hcne, hc0, hclen, hewf, hnod, helen, hflen⟩ diff --git a/bar.toml b/bar.toml index 15eb8f1..d94b724 100644 --- a/bar.toml +++ b/bar.toml @@ -29,8 +29,8 @@ code = [ # Well formedness. "ClientHello.ExtWF", "ClientHello.WF", # The length checked readers and the parser. - "ClientHello.getU8", "ClientHello.getU16", "ClientHello.getU24", - "ClientHello.getBytes", "ClientHello.parsePairs", + "ClientHello.getU16", "ClientHello.withU8", "ClientHello.withU16", + "ClientHello.withU24", "ClientHello.withBytes", "ClientHello.parsePairs", "ClientHello.parseNameEntriesGo", "ClientHello.parseNameEntries", "ClientHello.validNames", "ClientHello.parseSNI", "ClientHello.parseAlpnGo", "ClientHello.parseAlpnNames", "ClientHello.parseALPN", From 834ce44f7f7a153e196cad156e659054eaa6a539 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:05:14 +0000 Subject: [PATCH 05/19] Refuse a record longer than 2^14 bytes Review 1 finding 2, carried in the e4c149a reviews (should-fix): parse read the record length as any 16-bit value and WF allowed body fields up to 65531 bytes, so a 16385-byte record was accepted. RFC 8446 section 5.1 says the length MUST NOT exceed 2^14 bytes, and a receiver answers a longer record with record_overflow. - Parse.lean: parse refuses a record length above 16384, before it reads the body. - Value.lean: WF bounds the printed body fields by 16380, so the handshake message (4 header bytes and the fields) fits 16384. - Proofs: parse_print and print_parse carry the new bound. - Spec.lean: Spec.rejects_record_overflow states that for every content type, version bytes and following bytes, a length field above 16384 gives none. It is proved in Proofs/SpecProofs.lean and named in comparator.json. - SPEC.md and README state the rule, the theorem and the new WF bound, and SPEC's slice boundaries say that a hello split across records, or too large for one, is refused. - tests: the oracle refuses lengths above 16384; named cases at exactly 16384 (accepted) and 16385 (refused); 60 generated padded hellos within a few bytes of the limit on both sides. The run gives 4,907 inputs and 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 15 ++++++++++----- ClientHello/Value.lean | 8 +++++--- Proofs/RoundTrip.lean | 13 ++++++++++--- Proofs/SpecProofs.lean | 14 ++++++++++++++ README.md | 6 ++++-- SPEC.md | 14 ++++++++++++-- Spec.lean | 8 ++++++++ comparator.json | 1 + tests/TEST-RESULTS.md | 7 +++++-- tests/run_tests.py | 39 +++++++++++++++++++++++++++++++++++++++ 10 files changed, 108 insertions(+), 17 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index 67738da..058adb6 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -7,8 +7,9 @@ - The record header is five bytes: content type 22, a legacy record version carried unchecked, and a two byte - length. The body is exactly that many bytes, and no bytes - may follow the record. A body of length 0 cannot hold a + length of at most 2^14 = 16384 (RFC 8446 section 5.1). + The body is exactly that many bytes, and no bytes may + follow the record. A body of length 0 cannot hold a handshake header, so it is turned away by the body read. - The handshake header is a type byte, which must be 1, and a three byte length that must cover the rest of the @@ -282,14 +283,18 @@ def parseBody (body : List UInt8) : Option Hello := else none /-- Parse a whole message: one record, holding one - ClientHello, with no bytes after the record. -/ + ClientHello, with no bytes after the record. The record + length may not exceed 2^14 = 16384 bytes (RFC 8446 + section 5.1). -/ def parse (bs : List UInt8) : Option Message := withU8 bs fun ct r1 => if ct = 22 then withU16 r1 fun rv r2 => withU16 r2 fun rlen r3 => - withBytes rlen r3 fun body r4 => - if r4 = [] then (parseBody body).map fun h => ⟨rv, h⟩ + if rlen ≤ 16384 then + withBytes rlen r3 fun body r4 => + if r4 = [] then (parseBody body).map fun h => ⟨rv, h⟩ + else none else none else none diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean index f9ea71d..8da41ee 100644 --- a/ClientHello/Value.lean +++ b/ClientHello/Value.lean @@ -202,8 +202,10 @@ def ExtWF : Extension → Prop /-- A well formed message: every number fits the field that holds it, every byte block holds the length its field demands, the cipher suites and compression methods meet - their rules, every extension is well formed, and no - extension type stands twice. -/ + their rules, every extension is well formed, no + extension type stands twice, and the handshake message + (four header bytes and the body fields) fits a record of + at most 2^14 = 16384 bytes (RFC 8446 section 5.1). -/ def WF (m : Message) : Prop := m.recordVersion < 65536 ∧ m.hello.legacyVersion < 65536 ∧ @@ -218,6 +220,6 @@ def WF (m : Message) : Prop := (∀ e ∈ m.hello.extensions, ExtWF e) ∧ List.Nodup (m.hello.extensions.map extType) ∧ (printExts m.hello.extensions).length ≤ 65535 ∧ - (printBodyFields m.hello).length ≤ 65531 + (printBodyFields m.hello).length ≤ 16380 end ClientHello diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 8e62776..821f23a 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1900,11 +1900,15 @@ theorem parse_print (m : Message) (hw : WF m) : have hblt : (printBody m.hello).length < 65536 := by rw [printBody_length] omega + have hble : (printBody m.hello).length ≤ 16384 := by + rw [printBody_length] + omega rw [print_eq] unfold parse rw [withU8_cons, if_pos (by decide : ((22 : UInt8).toNat = 22)), - withU16_be16 hrv, withU16_be16 hblt, withBytes_self, - if_pos rfl, parseBody_print m hwf, Option.map_some] + withU16_be16 hrv, withU16_be16 hblt, if_pos hble, + withBytes_self, if_pos rfl, parseBody_print m hwf, + Option.map_some] /-- A parsed message prints back to the input bytes, and the message is well formed. -/ @@ -1918,6 +1922,9 @@ theorem print_parse {bs : List UInt8} {m : Message} rw [if_pos hct] at hp obtain ⟨rv, r2, hr1, hrv, hp⟩ := withU16_inv hp obtain ⟨rlen, r3, hr2, hrlen, hp⟩ := withU16_inv hp + by_cases hrl : rlen ≤ 16384 + case neg => rw [if_neg hrl] at hp; cases hp + rw [if_pos hrl] at hp obtain ⟨body, r4, hbodylen, hr3, hp⟩ := withBytes_inv hp by_cases hr : r4 = [] case neg => rw [if_neg hr] at hp; cases hp @@ -1929,7 +1936,7 @@ theorem print_parse {bs : List UInt8} {m : Message} have hctb : ct.toUInt8 = (22 : UInt8) := by rw [hct] decide - have hflen : (printBodyFields hh).length ≤ 65531 := by + have hflen : (printBodyFields hh).length ≤ 16380 := by have h1 := printBody_length hh rw [hbody_eq] at h1 omega diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index fcccf34..8ead421 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -65,6 +65,20 @@ theorem Spec.rejects_record_length_longer : decide +kernel +theorem Spec.rejects_record_overflow (ct v1 v2 a b : UInt8) + (rest : List UInt8) (h : 16384 < a.toNat * 256 + b.toNat) : + parse (ct :: v1 :: v2 :: a :: b :: rest) = none := by + have hover : ¬ (u16 a b ≤ 16384) := by + simp only [u16] + omega + unfold parse + rw [ClientHello.Proofs.withU8_cons] + by_cases hct : ct.toNat = 22 + · rw [if_pos hct, ClientHello.Proofs.withU16_cons, + ClientHello.Proofs.withU16_cons, if_neg hover] + · rw [if_neg hct] + + theorem Spec.rejects_trailing_bytes : (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0, 0] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index 7e76b66..d806d10 100644 --- a/README.md +++ b/README.md @@ -53,6 +53,7 @@ where they end in `sorry`) and proved in | A record length of 0 is refused. | `Spec.rejects_record_length_zero` | | A content type other than 22 is refused. | `Spec.rejects_content_type` | | A record length longer than the input is refused. | `Spec.rejects_record_length_longer` | +| A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | | Bytes after the record are refused. | `Spec.rejects_trailing_bytes` | | A handshake type other than 1 is refused. | `Spec.rejects_handshake_type` | | A handshake length that does not match the body is refused. | `Spec.rejects_handshake_length` | @@ -85,8 +86,9 @@ share groups are distinct with nonempty keys, and an opaque extension's type is none of the four decoded types); no extension type stands twice; the printed extensions block fits two bytes of length; and the -printed body fields fit the three byte handshake length -with room to spare (at most 65531 bytes). +printed handshake message, its four header bytes and the +body fields, is at most 2^14 = 16384 bytes, the record +limit of RFC 8446 section 5.1. The two round trip theorems rest on the proofs in `Proofs/RoundTrip.lean`, where they are diff --git a/SPEC.md b/SPEC.md index 08cd01e..9a49ba5 100644 --- a/SPEC.md +++ b/SPEC.md @@ -16,10 +16,14 @@ A message is one TLS record: |-------|-------| | 0 | content type: must be 22 (handshake) | | 1, 2 | legacy record version: carried, value unchecked | -| 3, 4 | length: two bytes, big endian | +| 3, 4 | length: two bytes, big endian, at most 2^14 = 16384 | | 5 ... | the record body, exactly that many bytes | - Input shorter than the five byte header rejects. +- A length above 2^14 = 16384 rejects, whatever follows. + RFC 8446 section 5.1 says the length "MUST NOT exceed + 2^14 bytes" and that a receiver answers a longer record + with a record_overflow alert. - A body shorter than the declared length rejects. - Bytes after the record reject. The decoder takes exactly one record; a stream reader is later work. @@ -166,6 +170,7 @@ each rule on many more inputs. | A record length of 0 is refused | `Spec.rejects_record_length_zero` | | A content type other than 22 is refused | `Spec.rejects_content_type` | | A record length longer than the input is refused | `Spec.rejects_record_length_longer` | +| A record length above 2^14 = 16384 is refused, whatever else the input holds | `Spec.rejects_record_overflow` | | Bytes after the record are refused | `Spec.rejects_trailing_bytes` | | A handshake type other than 1 is refused | `Spec.rejects_handshake_type` | | A handshake length that does not match the body is refused | `Spec.rejects_handshake_length` | @@ -206,4 +211,9 @@ This is the reader model used across the sibling slices. to the hostname work; this slice only carries the name bytes out of the message. - One record only: no stream reading, no record splitting - or joining, no alerts, no renegotiation. + or joining, no alerts, no renegotiation. RFC 8446 section + 5.1 lets a sender split a handshake message across + records; such a hello is refused here, since its first + record does not hold the whole message. A hello whose + handshake message is longer than 16384 bytes cannot fit + one record, so this slice refuses it. diff --git a/Spec.lean b/Spec.lean index 029c92d..d30abcb 100644 --- a/Spec.lean +++ b/Spec.lean @@ -87,6 +87,14 @@ theorem Spec.rejects_content_type : theorem Spec.rejects_record_length_longer : (parse ([22, 3, 1, 0, 10, 1, 0, 0, 0] : List UInt8)).isSome = false := sorry +/-- A record whose length field, bytes 3 and 4 read big endian, is above + 2^14 = 16384 is refused, whatever the other header bytes are and + whatever follows (RFC 8446 section 5.1: the length MUST NOT exceed + 2^14 bytes). -/ +theorem Spec.rejects_record_overflow (ct v1 v2 a b : UInt8) + (rest : List UInt8) (h : 16384 < a.toNat * 256 + b.toNat) : + parse (ct :: v1 :: v2 :: a :: b :: rest) = none := sorry + /-- Bytes after the record are refused rather than ignored. -/ theorem Spec.rejects_trailing_bytes : (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0, 0] : List UInt8)).isSome = false := sorry diff --git a/comparator.json b/comparator.json index cf6e79d..4547265 100644 --- a/comparator.json +++ b/comparator.json @@ -12,6 +12,7 @@ "Spec.rejects_record_length_zero", "Spec.rejects_content_type", "Spec.rejects_record_length_longer", + "Spec.rejects_record_overflow", "Spec.rejects_trailing_bytes", "Spec.rejects_handshake_type", "Spec.rejects_handshake_length", diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index fa826b2..fbf24aa 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -13,12 +13,13 @@ Python's ssl module cannot build a ClientHello on demand. Go is not installed (` | part | run | agreed | | --- | --- | --- | -| named cases | 30 | 30 | +| named cases | 32 | 32 | | generated messages | 3200 | 3200 | | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | +| hellos near the 2^14 record limit | 60 | 60 | | malformed request lines | 7 | 7 | -| total | 4845 | 4845 | +| total | 4907 | 4907 | Of the 3200 generated messages, the oracle accepts 1233 and rejects 1967. @@ -51,6 +52,8 @@ Of the 3200 generated messages, the oracle accepts 1233 and rejects 1967. - TLS 1.3 hello asking for a HelloRetryRequest (supported_groups, supported_versions 0x0304, empty key_share), accepted: accept (83 bytes) - trailing garbage after the record: reject (53 bytes) - empty extensions block, length 0, accepted: accept (52 bytes) +- record length 16384, the 2^14 limit, accepted: accept (16389 bytes) +- record length 16385, over the 2^14 limit: reject (16390 bytes) - record length zero: reject (5 bytes) - input shorter than the record header: reject (2 bytes) - empty input: reject (0 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index 48eef90..e695661 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -247,6 +247,10 @@ def oracle_parse_go(bs): raise Reject() rv, i = take(bs, i, 2) rlen, i = u16(bs, i) + # RFC 8446 section 5.1: the record length MUST NOT exceed + # 2^14 bytes. + if rlen > 16384: + raise Reject() body, i = take(bs, i, rlen) if i != len(bs): raise Reject() @@ -387,6 +391,33 @@ def raw_fields(suites_bytes, comps=(0,), exts=(), ext_block=True): return bytes([22, 3, 1]) + be16(len(body)) + body +def padded_hello(record_len, rng=None, base_exts=None): + """A TLS 1.3 style hello whose record body is exactly + record_len bytes, padded with a padding extension (21).""" + exts = list(base_exts if base_exts is not None + else [(43, sv_value([0x0304, 0x0303]))]) + probe = build_hello(exts=exts + [(21, b"")]) + pad = record_len - (len(probe) - 5) + fill = (bytes(rng.randrange(256) for _ in range(pad)) + if rng else bytes(pad)) + out = build_hello(exts=exts + [(21, fill)]) + assert len(out) - 5 == record_len + return out + + +def gen_near_limit(rng): + """Hellos whose record length is within a few bytes of the + 2^14 limit, on both sides of it.""" + out = [] + for _ in range(60): + n = rng.randrange(16376, 16393) + exts = [(43, sv_value([0x0304]))] + if rng.random() < 0.5: + exts.append((51, ks_value([(29, bytes(32))]))) + out.append(padded_hello(n, rng, exts)) + return out + + def named_cases(): """(name, bytes, expected: True accept / False reject).""" cases = [] @@ -472,6 +503,10 @@ def named_cases(): build_hello(trailing=b"\x00"), False)) cases.append(("empty extensions block, length 0, accepted", EMPTY_EXT_HELLO, True)) + cases.append(("record length 16384, the 2^14 limit, accepted", + padded_hello(16384), True)) + cases.append(("record length 16385, over the 2^14 limit", + padded_hello(16385), False)) cases.append(("record length zero", bytes([22, 3, 1, 0, 0]), False)) cases.append(("input shorter than the record header", @@ -782,6 +817,10 @@ def main(): n, a = check_batch(raw, "random raw", failures) tally["random raw byte strings"] = (n, a) + near = gen_near_limit(rng) + n, a = check_batch(near, "near the record limit", failures) + tally["hellos near the 2^14 record limit"] = (n, a) + malformed = ["parse 256", "parse 1,x", "parse 1,,2", "peek 1,2", "parse -1", "parse 1 2", "parse 999999999999"] From d2ff5d72b29bce868d1bb0b5f6d705450aa58c5b Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:08:21 +0000 Subject: [PATCH 06/19] Require compression methods [0] in a hello that offers TLS 1.3 Review 1 finding 3, carried in the e4c149a reviews (should-fix): the parser checked only that 0 is among the compression methods, so legacy_compression_methods 01 00 with supported_versions [0x0304] was accepted. RFC 8446 section 4.1.2 says that for every TLS 1.3 ClientHello the vector MUST contain exactly one byte, set to zero, and a server MUST abort with illegal_parameter otherwise. SPEC.md listed the weaker rule as a pinned reading, but for TLS 1.3 the RFC leaves nothing open. - Value.lean: new offersTls13, true when a supported_versions extension lists 0x0304. WF requires offersTls13 exts = true -> comps = [0]. - Parse.lean: parseBodyFields refuses a hello that offers TLS 1.3 with any other compression list. A hello that does not offer TLS 1.3 keeps the RFC 5246 section 7.4.1.2 rule, which says the list must contain the null method. - Proofs: the round trip and the inverse lemmas carry the new conjunct. - Spec.lean, proved in Proofs/SpecProofs.lean and named in comparator.json: - Spec.tls13_compression_null: every accepted hello that offers TLS 1.3 has exactly the compression methods [0]. - Spec.rejects_tls13_compression: the hello of Spec.accepts_supported_versions with compression methods [1, 0] is refused. - Spec.accepts_tls12_compression: a hello with no extensions and compression methods [1, 0] is accepted, so the rule is tied to TLS 1.3 and not applied to every hello. - bar.toml: the code list names offersTls13 and the fields the new statement reads (Message.hello, Hello.extensions, Hello.compressionMethods). - SPEC.md and README state the rule, its RFC source and the new theorems. The pinned readings now say only what "offers TLS 1.3" means. - tests: the oracle applies the rule; named cases cover 01 00 and 00 00 with TLS 1.3 (refused) and 01 00 without it (accepted). The run gives 4,911 inputs and 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 16 +++++++++++----- ClientHello/Value.lean | 15 ++++++++++++++- Proofs/RoundTrip.lean | 25 +++++++++++++++++-------- Proofs/SpecProofs.lean | 19 +++++++++++++++++++ README.md | 6 +++++- SPEC.md | 21 +++++++++++++++++++-- Spec.lean | 28 ++++++++++++++++++++++++++++ bar.toml | 7 +++++-- comparator.json | 3 +++ tests/TEST-RESULTS.md | 10 +++++++--- tests/run_tests.py | 22 ++++++++++++++++++++++ 11 files changed, 150 insertions(+), 22 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index 058adb6..c055c5d 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -17,9 +17,11 @@ - The body fields follow their length rules: session id at most 32 bytes; cipher suites an even byte count of at least 2; compression methods at least one byte and the - null method 0 among them. A body that ends before the - extensions length is turned away: the extensions block - must be present, though it may be empty. + null method 0 among them, and exactly the one byte 0 + when supported_versions lists TLS 1.3 (0x0304). A body + that ends before the extensions length is turned away: + the extensions block must be present, though it may be + empty. - The extensions block is consumed exactly. Each extension is a type, a length, and that many value bytes; a length running past the block turns the message away, and a @@ -263,8 +265,12 @@ def parseBodyFields (bs : List UInt8) : Option Hello := withU16 r8 fun elen r9 => withBytes elen r9 fun ebytes r10 => if r10 = [] then - (parseExts ebytes).map fun exts => - ⟨ver, rand, sess, suites, comps, exts⟩ + (parseExts ebytes).bind fun exts => + -- RFC 8446 section 4.1.2: a TLS 1.3 ClientHello + -- carries exactly one compression method, null. + if offersTls13 exts = true → comps = [0] then + some ⟨ver, rand, sess, suites, comps, exts⟩ + else none else none else none else none diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean index 8da41ee..c257bd7 100644 --- a/ClientHello/Value.lean +++ b/ClientHello/Value.lean @@ -173,6 +173,15 @@ def print (m : Message) : List UInt8 := (22 : UInt8) :: (be16 m.recordVersion ++ (be16 (printBody m.hello).length ++ printBody m.hello)) +/-- Whether an extension list offers TLS 1.3: it holds a + supported_versions extension that lists 0x0304 (772). Such + a hello is a TLS 1.3 ClientHello in the sense of RFC 8446 + section 4.1.2, whatever older versions it also lists. -/ +def offersTls13 : List Extension → Bool + | [] => false + | .supportedVersions vs :: es => vs.contains 772 || offersTls13 es + | _ :: es => offersTls13 es + /-- Well formedness of one extension, at the level the printer needs: every length it writes fits the field that holds it, and the checks the parser makes on the value @@ -203,7 +212,9 @@ def ExtWF : Extension → Prop holds it, every byte block holds the length its field demands, the cipher suites and compression methods meet their rules, every extension is well formed, no - extension type stands twice, and the handshake message + extension type stands twice, a hello that offers TLS 1.3 + carries exactly the null compression method (RFC 8446 + section 4.1.2), and the handshake message (four header bytes and the body fields) fits a record of at most 2^14 = 16384 bytes (RFC 8446 section 5.1). -/ def WF (m : Message) : Prop := @@ -219,6 +230,8 @@ def WF (m : Message) : Prop := m.hello.compressionMethods.length ≤ 255 ∧ (∀ e ∈ m.hello.extensions, ExtWF e) ∧ List.Nodup (m.hello.extensions.map extType) ∧ + (offersTls13 m.hello.extensions = true → + m.hello.compressionMethods = [0]) ∧ (printExts m.hello.extensions).length ≤ 65535 ∧ (printBodyFields m.hello).length ≤ 16380 diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 821f23a..ac5fe76 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1705,7 +1705,7 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : parseBodyFields (printBodyFields m.hello) = some m.hello := by obtain ⟨_, hver, hrand, hsess, hsuites_ne, hsuites_lt, hsuites_len, hcomp_ne, hcomp0, hcomp_len, hext_wf, - hnodup, hext_len, _⟩ := hw + hnodup, h13, hext_len, _⟩ := hw have hsuites_len1 : 1 ≤ m.hello.cipherSuites.length := by cases hcs : m.hello.cipherSuites with | nil => exact absurd hcs hsuites_ne @@ -1734,7 +1734,8 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : parsePairs_printPairs hsuites_lt, Option.bind_some, withU8_cons, hcb, if_pos hcomp_len1, withBytes_app rfl, if_pos hcomp0, withU16_be16 (by omega), withBytes_self, - if_pos rfl, parseExts_print hext_wf hnodup, Option.map_some] + if_pos rfl, parseExts_print hext_wf hnodup, Option.bind_some, + if_pos h13] /-- A parsed hello prints back to the input bytes, and every field satisfies the well formedness bounds. -/ @@ -1751,6 +1752,8 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} h.compressionMethods.length ≤ 255 ∧ (∀ e ∈ h.extensions, ExtWF e) ∧ List.Nodup (h.extensions.map extType) ∧ + (offersTls13 h.extensions = true → + h.compressionMethods = [0]) ∧ (printExts h.extensions).length ≤ 65535 := by unfold parseBodyFields at hparse obtain ⟨ver, r1, hbs, hver, hp⟩ := withU16_inv hparse @@ -1779,7 +1782,11 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} by_cases hr : r10 = [] case neg => rw [if_neg hr] at hp; cases hp rw [if_pos hr] at hp - obtain ⟨exts, s12, hp⟩ := Option.map_eq_some_iff.mp hp + obtain ⟨exts, s12, hp⟩ := Option.bind_eq_some_iff.mp hp + by_cases h13 : offersTls13 exts = true → comps = [0] + case neg => rw [if_neg h13] at hp; cases hp + rw [if_pos h13] at hp + simp only [Option.some.injEq] at hp subst hp have hpp : printPairs suites = cbytes := (parsePairs_inv s7).1 have hsuites_lt : ∀ v ∈ suites, v < 65536 := @@ -1819,7 +1826,7 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} hbs, hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr, List.append_nil] exact ⟨hprint, hver, hrand, hsess_le, hsuites_ne, hsuites_lt, - hsuites_len, hcomp_ne, h0, hcomp_len, hext_wf, hnodup, + hsuites_len, hcomp_ne, h0, hcomp_len, hext_wf, hnodup, h13, hext_len⟩ /-! ## The handshake message and the record -/ @@ -1841,7 +1848,7 @@ theorem printBody_eq (h : Hello) : theorem parseBody_print (m : Message) (hw : WF m) : parseBody (printBody m.hello) = some m.hello := by have hwf : WF m := hw - obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, hflen⟩ := hw rw [printBody_eq] unfold parseBody @@ -1864,6 +1871,8 @@ theorem parseBody_inv {body : List UInt8} {h : Hello} h.compressionMethods.length ≤ 255 ∧ (∀ e ∈ h.extensions, ExtWF e) ∧ List.Nodup (h.extensions.map extType) ∧ + (offersTls13 h.extensions = true → + h.compressionMethods = [0]) ∧ (printExts h.extensions).length ≤ 65535 := by unfold parseBody at hparse obtain ⟨htype, r1, hbody1, _, hp⟩ := withU8_inv hparse @@ -1895,7 +1904,7 @@ theorem print_eq (m : Message) : theorem parse_print (m : Message) (hw : WF m) : parse (print m) = some m := by have hwf : WF m := hw - obtain ⟨hrv, _, _, _, _, _, _, _, _, _, _, _, _, + obtain ⟨hrv, _, _, _, _, _, _, _, _, _, _, _, _, _, hflen⟩ := hw have hblt : (printBody m.hello).length < 65536 := by rw [printBody_length] @@ -1932,7 +1941,7 @@ theorem print_parse {bs : List UInt8} {m : Message} obtain ⟨hh, hpb, hp⟩ := Option.map_eq_some_iff.mp hp subst hp obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, hslen, hcne, - hc0, hclen, hewf, hnod, helen⟩ := parseBody_inv hpb + hc0, hclen, hewf, hnod, h13, helen⟩ := parseBody_inv hpb have hctb : ct.toUInt8 = (22 : UInt8) := by rw [hct] decide @@ -1947,4 +1956,4 @@ theorem print_parse {bs : List UInt8} {m : Message} rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, hr3, hr, List.append_nil] exact ⟨hprint, hrv, hver, hrand, hsess, hsne, hslt, hslen, - hcne, hc0, hclen, hewf, hnod, helen, hflen⟩ + hcne, hc0, hclen, hewf, hnod, h13, helen, hflen⟩ diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index 8ead421..a6670e6 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -22,6 +22,14 @@ theorem Spec.print_parse {bs : List UInt8} {m : Message} ClientHello.Proofs.print_parse hparse +theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) + (h13 : offersTls13 m.hello.extensions = true) : + m.hello.compressionMethods = [0] := by + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, hc13, _, _⟩ := + (ClientHello.Proofs.print_parse hparse).2 + exact hc13 h13 + theorem Spec.accepts_empty_extensions : (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).map print = some ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8) := by @@ -40,6 +48,12 @@ theorem Spec.accepts_key_share_empty_list : decide +kernel +theorem Spec.accepts_tls12_compression : + (parse ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8) := by + decide +kernel + + theorem Spec.rejects_empty : (parse ([] : List UInt8)).isSome = false := by decide +kernel @@ -124,6 +138,11 @@ theorem Spec.rejects_empty_compression : decide +kernel +theorem Spec.rejects_tls13_compression : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by + decide +kernel + + theorem Spec.rejects_duplicate_extension : (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index d806d10..98aa519 100644 --- a/README.md +++ b/README.md @@ -48,6 +48,8 @@ where they end in `sorry`) and proved in | A hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | | A minimal hello carrying only supported_versions is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | | A TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | +| A hello that does not offer TLS 1.3 may list compression methods besides null: one with [1, 0] and no extensions is accepted and writes back as the same bytes. | `Spec.accepts_tls12_compression` | +| Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | | Empty input is refused. | `Spec.rejects_empty` | | Input shorter than the record header is refused. | `Spec.rejects_short_header` | | A record length of 0 is refused. | `Spec.rejects_record_length_zero` | @@ -63,6 +65,7 @@ where they end in `sorry`) and proved in | An empty cipher suite list is refused. | `Spec.rejects_empty_cipher_suites` | | Compression methods without the null method 0 are refused. | `Spec.rejects_compression_without_null` | | An empty compression method list is refused. | `Spec.rejects_empty_compression` | +| A hello that offers TLS 1.3 with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | | An extension type standing twice is refused. | `Spec.rejects_duplicate_extension` | | An extension length running past the block is refused. | `Spec.rejects_extension_overrun` | | A key share group standing twice is refused. | `Spec.rejects_duplicate_key_share_group` | @@ -79,7 +82,8 @@ exactly 32 bytes; the session id holds at most 32 bytes; the cipher suites are nonempty, each fits two bytes, and there are at most 32767 of them; the compression methods are nonempty, contain the null method 0, and number at -most 255; every extension is well formed (its lengths fit +most 255, and are exactly [0] when the hello offers TLS 1.3 +(its supported_versions lists 0x0304); every extension is well formed (its lengths fit their fields, SNI has distinct entry types and a nonempty host name when present, ALPN names are nonempty, key share groups are distinct with nonempty keys, and an diff --git a/SPEC.md b/SPEC.md index 9a49ba5..05d579e 100644 --- a/SPEC.md +++ b/SPEC.md @@ -55,9 +55,20 @@ In order: | random | 32 bytes | exactly 32 | | legacy session id | 1 byte length, then that many bytes | length at most 32; a longer length rejects | | cipher suites | 2 byte length, then that many bytes | length even and at least 2; the bytes read as two byte suite codes; an empty list or an odd length rejects | -| legacy compression methods | 1 byte length, then that many bytes | length at least 1; the list must contain the byte 0 (the null method) | +| legacy compression methods | 1 byte length, then that many bytes | length at least 1; the list must contain the byte 0 (the null method); in a hello that offers TLS 1.3 it must be exactly the one byte 0 | | extensions | 2 byte length, then that many bytes | the block must consume the rest of the body exactly | +Compression methods. RFC 5246 section 7.4.1.2 says the +list "MUST contain" the null method, so a list without the +byte 0 rejects. A hello offers TLS 1.3 when it has a +supported_versions extension that lists 0x0304. RFC 8446 +section 4.1.2 says that for every TLS 1.3 ClientHello the +list "MUST contain exactly one byte, set to zero", and that +a server must abort otherwise, so a hello that offers TLS +1.3 with any other list rejects: [1, 0] and [0, 0] both +reject. A hello that does not offer TLS 1.3 may list other +methods besides 0. + The extensions block must be present. A body that ends after the compression methods is the pre-TLS-1.3 shape; this slice rejects it, because the slice frames the @@ -139,7 +150,10 @@ slice pins it: - Trailing bytes after the record reject. - A missing extensions block rejects; a present block of length 0 is accepted. -- Compression methods must contain the byte 0. +- A hello offers TLS 1.3 exactly when its + supported_versions lists 0x0304; draft version numbers + such as 0x7F1C do not count. Only such a hello must have + the compression methods [0]. - The session id length is at most 32. - The cipher suite list is nonempty, with an even byte length. @@ -165,6 +179,8 @@ each rule on many more inputs. | A present, empty extensions block is accepted | `Spec.accepts_empty_extensions` | | A minimal hello with only supported_versions is accepted | `Spec.accepts_supported_versions` | | A TLS 1.3 hello whose key_share carries no entries, as a client asking for a HelloRetryRequest sends it, is accepted | `Spec.accepts_key_share_empty_list` | +| A hello that does not offer TLS 1.3 may list compression methods besides null | `Spec.accepts_tls12_compression` | +| An accepted hello that offers TLS 1.3 has exactly the compression methods [0] | `Spec.tls13_compression_null` | | Empty input is refused | `Spec.rejects_empty` | | Input shorter than the record header is refused | `Spec.rejects_short_header` | | A record length of 0 is refused | `Spec.rejects_record_length_zero` | @@ -180,6 +196,7 @@ each rule on many more inputs. | An empty cipher suite list is refused | `Spec.rejects_empty_cipher_suites` | | Compression methods must contain the null method 0 | `Spec.rejects_compression_without_null` | | An empty compression method list is refused | `Spec.rejects_empty_compression` | +| A hello that offers TLS 1.3 with compression methods [1, 0] is refused | `Spec.rejects_tls13_compression` | | A duplicate extension type is refused | `Spec.rejects_duplicate_extension` | | An extension length running past the block is refused | `Spec.rejects_extension_overrun` | | A duplicate key share group is refused | `Spec.rejects_duplicate_key_share_group` | diff --git a/Spec.lean b/Spec.lean index d30abcb..df49fc0 100644 --- a/Spec.lean +++ b/Spec.lean @@ -35,6 +35,20 @@ theorem Spec.print_parse {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : print m = bs ∧ WF m := sorry +/-! ## Rules every accepted message meets + +Each of these follows from `Spec.print_parse`, since the well formedness +predicate includes the rule; it is stated on its own so that the claim on +the page names a theorem that says exactly that. -/ + +/-- An accepted hello that offers TLS 1.3, that is whose supported_versions + lists 0x0304, carries exactly one compression method, the null method + 0 (RFC 8446 section 4.1.2). -/ +theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) + (h13 : offersTls13 m.hello.extensions = true) : + m.hello.compressionMethods = [0] := sorry + /-! ## Accepted examples Single inputs the parser accepts. Each one is stated in the form the @@ -60,6 +74,13 @@ theorem Spec.accepts_key_share_empty_list : (parse ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8)).map print = some ([22, 3, 1, 0, 78, 1, 0, 0, 74, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 31, 0, 10, 0, 6, 0, 4, 0, 29, 0, 23, 0, 43, 0, 3, 2, 3, 4, 0, 51, 0, 2, 0, 0, 0, 13, 0, 4, 0, 2, 4, 3] : List UInt8) := sorry +/-- A hello that does not offer TLS 1.3 (it has no extensions) may list + compression methods besides null: here [1, 0]. It is accepted and writes + back as the same bytes. -/ +theorem Spec.accepts_tls12_compression : + (parse ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8) := sorry + /-! ## Refused inputs Single inputs the parser refuses, one for each headline rule of @@ -131,6 +152,13 @@ theorem Spec.rejects_compression_without_null : theorem Spec.rejects_empty_compression : (parse ([22, 3, 1, 0, 44, 1, 0, 0, 40, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0] : List UInt8)).isSome = false := sorry +/-- A hello that offers TLS 1.3 and lists compression methods [1, 0] is + refused: for TLS 1.3 the list must be exactly [0]. The input is the + hello of `Spec.accepts_supported_versions` with that one field + changed. -/ +theorem Spec.rejects_tls13_compression : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry + /-- An extension type standing twice in one block is refused. -/ theorem Spec.rejects_duplicate_extension : (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := sorry diff --git a/bar.toml b/bar.toml index d94b724..4c44f5d 100644 --- a/bar.toml +++ b/bar.toml @@ -20,14 +20,17 @@ code = [ "ClientHello.Extension.serverName", "ClientHello.Extension.alpn", "ClientHello.Extension.supportedVersions", "ClientHello.Extension.keyShare", "ClientHello.Extension.opaque", + # The fields the statements about every accepted message read. + "ClientHello.Message.hello", "ClientHello.Hello.extensions", + "ClientHello.Hello.compressionMethods", # The byte forms and the printer. "ClientHello.be16", "ClientHello.u16", "ClientHello.be24", "ClientHello.u24", "ClientHello.extType", "ClientHello.printPairs", "ClientHello.printNameEntries", "ClientHello.printAlpnNames", "ClientHello.printShares", "ClientHello.printExtValue", "ClientHello.printExt", "ClientHello.printExts", "ClientHello.printBodyFields", "ClientHello.printBody", "ClientHello.print", - # Well formedness. - "ClientHello.ExtWF", "ClientHello.WF", + # Well formedness, and whether a hello offers TLS 1.3. + "ClientHello.ExtWF", "ClientHello.WF", "ClientHello.offersTls13", # The length checked readers and the parser. "ClientHello.getU16", "ClientHello.withU8", "ClientHello.withU16", "ClientHello.withU24", "ClientHello.withBytes", "ClientHello.parsePairs", diff --git a/comparator.json b/comparator.json index 4547265..647df26 100644 --- a/comparator.json +++ b/comparator.json @@ -4,9 +4,11 @@ "theorem_names": [ "Spec.parse_print", "Spec.print_parse", + "Spec.tls13_compression_null", "Spec.accepts_empty_extensions", "Spec.accepts_supported_versions", "Spec.accepts_key_share_empty_list", + "Spec.accepts_tls12_compression", "Spec.rejects_empty", "Spec.rejects_short_header", "Spec.rejects_record_length_zero", @@ -22,6 +24,7 @@ "Spec.rejects_empty_cipher_suites", "Spec.rejects_compression_without_null", "Spec.rejects_empty_compression", + "Spec.rejects_tls13_compression", "Spec.rejects_duplicate_extension", "Spec.rejects_extension_overrun", "Spec.rejects_duplicate_key_share_group", diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index fbf24aa..5fc60bd 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -13,15 +13,15 @@ Python's ssl module cannot build a ClientHello on demand. Go is not installed (` | part | run | agreed | | --- | --- | --- | -| named cases | 32 | 32 | +| named cases | 36 | 36 | | generated messages | 3200 | 3200 | | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | | hellos near the 2^14 record limit | 60 | 60 | | malformed request lines | 7 | 7 | -| total | 4907 | 4907 | +| total | 4911 | 4911 | -Of the 3200 generated messages, the oracle accepts 1233 and rejects 1967. +Of the 3200 generated messages, the oracle accepts 1199 and rejects 2001. ## Named cases @@ -38,6 +38,10 @@ Of the 3200 generated messages, the oracle accepts 1233 and rejects 1967. - odd cipher suite length: reject (53 bytes) - empty cipher suites: reject (50 bytes) - compression methods without 0: reject (53 bytes) +- TLS 1.3 hello with compression methods 01 00: reject (60 bytes) +- TLS 1.3 hello with compression methods 00 00: reject (62 bytes) +- TLS 1.2 hello (supported_versions 0x0303 only) with compression methods 01 00, accepted: accept (60 bytes) +- hello without extensions, compression methods 01 00, accepted: accept (53 bytes) - missing extensions block: reject (50 bytes) - supported versions odd length: reject (60 bytes) - supported versions length zero: reject (57 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index e695661..2d52835 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -285,6 +285,12 @@ def oracle_parse_go(bs): if k != len(fields): raise Reject() exts = oracle_exts(bytes(block)) + # RFC 8446 section 4.1.2: a hello that offers TLS 1.3 (its + # supported_versions lists 0x0304) carries exactly one + # compression method, null. + offers13 = any(e[0] == "sv" and 0x0304 in e[1] for _, e in exts) + if offers13 and bytes(comps) != b"\x00": + raise Reject() out_fields = bytes(ver) + bytes(rand) out_fields += bytes([len(sess)]) + bytes(sess) pairs = b"" @@ -458,6 +464,22 @@ def named_cases(): build_hello(suites=()), False)) cases.append(("compression methods without 0", build_hello(comps=(1, 2)), False)) + cases.append(("TLS 1.3 hello with compression methods 01 00", + build_hello(comps=(1, 0), + exts=[(43, sv_value([0x0304]))]), + False)) + cases.append(("TLS 1.3 hello with compression methods 00 00", + build_hello(comps=(0, 0), + exts=[(43, sv_value([0x0304, 0x0303]))]), + False)) + cases.append(("TLS 1.2 hello (supported_versions 0x0303 only) " + "with compression methods 01 00, accepted", + build_hello(comps=(1, 0), + exts=[(43, sv_value([0x0303]))]), + True)) + cases.append(("hello without extensions, compression methods " + "01 00, accepted", + build_hello(comps=(1, 0)), True)) cases.append(("missing extensions block", build_hello(ext_block=False), False)) cases.append(("supported versions odd length", From 3f28a47c9d91e582e9092fd6eb61139371fa1421 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:10:22 +0000 Subject: [PATCH 07/19] Refuse a pre_shared_key extension that is not the last extension Review 1 finding 4, carried in the e4c149a reviews (should-fix): pre_shared_key (type 41) was carried opaque with only the duplicate check, so a hello with it before key_share was accepted. RFC 8446 section 4.2 says it MUST be the last extension in the ClientHello, and section 4.2.11 says servers MUST check that and fail with illegal_parameter otherwise. A consumer that computes PSK binders over the bytes before it relies on the rule. - Parse.lean: parseBodyFields refuses an extension list in which type 41 stands anywhere but last (41 not in the types of exts.dropLast). - Value.lean: WF has the same condition. - Proofs: the round trip and the inverse lemmas carry it. - Spec.lean, proved in Proofs/SpecProofs.lean and named in comparator.json: - Spec.psk_last: in every accepted hello, no extension but the last has type 41. - Spec.accepts_psk_last: a hello with supported_versions and then pre_shared_key is accepted. - Spec.rejects_psk_not_last: the same two extensions in the other order are refused. - SPEC.md and README state the rule and the theorems. SPEC's slice boundaries now say that rules tying one extension to another (for example psk_key_exchange_modes with pre_shared_key, RFC 8446 section 4.2.9) are not checked. - tests: the oracle applies the rule; named cases put a pre_shared_key with an identity and a binder last (accepted), before key_share and first of two (refused); the generator now draws type 41, and it lands both last and not last. The run gives 4,914 inputs and 0 failures. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 15 ++++++++++----- ClientHello/Value.lean | 9 ++++++--- Proofs/RoundTrip.lean | 21 +++++++++++++-------- Proofs/SpecProofs.lean | 20 +++++++++++++++++++- README.md | 6 +++++- SPEC.md | 16 ++++++++++++++++ Spec.lean | 19 +++++++++++++++++++ comparator.json | 3 +++ tests/TEST-RESULTS.md | 9 ++++++--- tests/run_tests.py | 37 +++++++++++++++++++++++++++++++++++-- 10 files changed, 132 insertions(+), 23 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index c055c5d..51b507a 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -25,7 +25,8 @@ - The extensions block is consumed exactly. Each extension is a type, a length, and that many value bytes; a length running past the block turns the message away, and a - type standing twice turns it away. + type standing twice turns it away. pre_shared_key (41) + may only stand last. - Four extension values are decoded. In each, the inner length must cover the rest of the value exactly. Server name entries may not repeat a name type, and a host_name @@ -266,10 +267,14 @@ def parseBodyFields (bs : List UInt8) : Option Hello := withBytes elen r9 fun ebytes r10 => if r10 = [] then (parseExts ebytes).bind fun exts => - -- RFC 8446 section 4.1.2: a TLS 1.3 ClientHello - -- carries exactly one compression method, null. - if offersTls13 exts = true → comps = [0] then - some ⟨ver, rand, sess, suites, comps, exts⟩ + -- RFC 8446 section 4.2.11: pre_shared_key (41) + -- must be the last extension. + if 41 ∉ (exts.dropLast).map extType then + -- RFC 8446 section 4.1.2: a TLS 1.3 ClientHello + -- carries exactly one compression method, null. + if offersTls13 exts = true → comps = [0] then + some ⟨ver, rand, sess, suites, comps, exts⟩ + else none else none else none else none diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean index c257bd7..ccccd20 100644 --- a/ClientHello/Value.lean +++ b/ClientHello/Value.lean @@ -212,9 +212,11 @@ def ExtWF : Extension → Prop holds it, every byte block holds the length its field demands, the cipher suites and compression methods meet their rules, every extension is well formed, no - extension type stands twice, a hello that offers TLS 1.3 - carries exactly the null compression method (RFC 8446 - section 4.1.2), and the handshake message + extension type stands twice, pre_shared_key (type 41) + stands last if present (RFC 8446 section 4.2.11), a + hello that offers TLS 1.3 carries exactly the null + compression method (RFC 8446 section 4.1.2), and the + handshake message (four header bytes and the body fields) fits a record of at most 2^14 = 16384 bytes (RFC 8446 section 5.1). -/ def WF (m : Message) : Prop := @@ -230,6 +232,7 @@ def WF (m : Message) : Prop := m.hello.compressionMethods.length ≤ 255 ∧ (∀ e ∈ m.hello.extensions, ExtWF e) ∧ List.Nodup (m.hello.extensions.map extType) ∧ + 41 ∉ (m.hello.extensions.dropLast).map extType ∧ (offersTls13 m.hello.extensions = true → m.hello.compressionMethods = [0]) ∧ (printExts m.hello.extensions).length ≤ 65535 ∧ diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index ac5fe76..f37f3f7 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1705,7 +1705,7 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : parseBodyFields (printBodyFields m.hello) = some m.hello := by obtain ⟨_, hver, hrand, hsess, hsuites_ne, hsuites_lt, hsuites_len, hcomp_ne, hcomp0, hcomp_len, hext_wf, - hnodup, h13, hext_len, _⟩ := hw + hnodup, hpsk, h13, hext_len, _⟩ := hw have hsuites_len1 : 1 ≤ m.hello.cipherSuites.length := by cases hcs : m.hello.cipherSuites with | nil => exact absurd hcs hsuites_ne @@ -1735,7 +1735,7 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : withU8_cons, hcb, if_pos hcomp_len1, withBytes_app rfl, if_pos hcomp0, withU16_be16 (by omega), withBytes_self, if_pos rfl, parseExts_print hext_wf hnodup, Option.bind_some, - if_pos h13] + if_pos hpsk, if_pos h13] /-- A parsed hello prints back to the input bytes, and every field satisfies the well formedness bounds. -/ @@ -1752,6 +1752,7 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} h.compressionMethods.length ≤ 255 ∧ (∀ e ∈ h.extensions, ExtWF e) ∧ List.Nodup (h.extensions.map extType) ∧ + 41 ∉ (h.extensions.dropLast).map extType ∧ (offersTls13 h.extensions = true → h.compressionMethods = [0]) ∧ (printExts h.extensions).length ≤ 65535 := by @@ -1783,6 +1784,9 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} case neg => rw [if_neg hr] at hp; cases hp rw [if_pos hr] at hp obtain ⟨exts, s12, hp⟩ := Option.bind_eq_some_iff.mp hp + by_cases hpsk : 41 ∉ (exts.dropLast).map extType + case neg => rw [if_neg hpsk] at hp; cases hp + rw [if_pos hpsk] at hp by_cases h13 : offersTls13 exts = true → comps = [0] case neg => rw [if_neg h13] at hp; cases hp rw [if_pos h13] at hp @@ -1826,8 +1830,8 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} hbs, hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr, List.append_nil] exact ⟨hprint, hver, hrand, hsess_le, hsuites_ne, hsuites_lt, - hsuites_len, hcomp_ne, h0, hcomp_len, hext_wf, hnodup, h13, - hext_len⟩ + hsuites_len, hcomp_ne, h0, hcomp_len, hext_wf, hnodup, hpsk, + h13, hext_len⟩ /-! ## The handshake message and the record -/ @@ -1848,7 +1852,7 @@ theorem printBody_eq (h : Hello) : theorem parseBody_print (m : Message) (hw : WF m) : parseBody (printBody m.hello) = some m.hello := by have hwf : WF m := hw - obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hflen⟩ := hw rw [printBody_eq] unfold parseBody @@ -1871,6 +1875,7 @@ theorem parseBody_inv {body : List UInt8} {h : Hello} h.compressionMethods.length ≤ 255 ∧ (∀ e ∈ h.extensions, ExtWF e) ∧ List.Nodup (h.extensions.map extType) ∧ + 41 ∉ (h.extensions.dropLast).map extType ∧ (offersTls13 h.extensions = true → h.compressionMethods = [0]) ∧ (printExts h.extensions).length ≤ 65535 := by @@ -1904,7 +1909,7 @@ theorem print_eq (m : Message) : theorem parse_print (m : Message) (hw : WF m) : parse (print m) = some m := by have hwf : WF m := hw - obtain ⟨hrv, _, _, _, _, _, _, _, _, _, _, _, _, _, + obtain ⟨hrv, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hflen⟩ := hw have hblt : (printBody m.hello).length < 65536 := by rw [printBody_length] @@ -1941,7 +1946,7 @@ theorem print_parse {bs : List UInt8} {m : Message} obtain ⟨hh, hpb, hp⟩ := Option.map_eq_some_iff.mp hp subst hp obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, hslen, hcne, - hc0, hclen, hewf, hnod, h13, helen⟩ := parseBody_inv hpb + hc0, hclen, hewf, hnod, hpsk, h13, helen⟩ := parseBody_inv hpb have hctb : ct.toUInt8 = (22 : UInt8) := by rw [hct] decide @@ -1956,4 +1961,4 @@ theorem print_parse {bs : List UInt8} {m : Message} rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, hr3, hr, List.append_nil] exact ⟨hprint, hrv, hver, hrand, hsess, hsne, hslt, hslen, - hcne, hc0, hclen, hewf, hnod, h13, helen, hflen⟩ + hcne, hc0, hclen, hewf, hnod, hpsk, h13, helen, hflen⟩ diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index a6670e6..bafcc68 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -26,10 +26,17 @@ theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} (hparse : parse bs = some m) (h13 : offersTls13 m.hello.extensions = true) : m.hello.compressionMethods = [0] := by - obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, hc13, _, _⟩ := + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hc13, _, _⟩ := (ClientHello.Proofs.print_parse hparse).2 exact hc13 h13 +theorem Spec.psk_last {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) : + 41 ∉ (m.hello.extensions.dropLast).map extType := by + obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, hpsk, _, _, _⟩ := + (ClientHello.Proofs.print_parse hparse).2 + exact hpsk + theorem Spec.accepts_empty_extensions : (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8)).map print = some ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0] : List UInt8) := by @@ -54,6 +61,12 @@ theorem Spec.accepts_tls12_compression : decide +kernel +theorem Spec.accepts_psk_last : + (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8) := by + decide +kernel + + theorem Spec.rejects_empty : (parse ([] : List UInt8)).isSome = false := by decide +kernel @@ -148,6 +161,11 @@ theorem Spec.rejects_duplicate_extension : decide +kernel +theorem Spec.rejects_psk_not_last : + (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 41, 0, 2, 0, 0, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by + decide +kernel + + theorem Spec.rejects_extension_overrun : (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 0, 0, 10, 2, 3, 4] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index 98aa519..6c6c8b0 100644 --- a/README.md +++ b/README.md @@ -50,6 +50,8 @@ where they end in `sorry`) and proved in | A TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | | A hello that does not offer TLS 1.3 may list compression methods besides null: one with [1, 0] and no extensions is accepted and writes back as the same bytes. | `Spec.accepts_tls12_compression` | | Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | +| A hello whose last extension is pre_shared_key is accepted and writes back as the same bytes. | `Spec.accepts_psk_last` | +| In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | | Empty input is refused. | `Spec.rejects_empty` | | Input shorter than the record header is refused. | `Spec.rejects_short_header` | | A record length of 0 is refused. | `Spec.rejects_record_length_zero` | @@ -67,6 +69,7 @@ where they end in `sorry`) and proved in | An empty compression method list is refused. | `Spec.rejects_empty_compression` | | A hello that offers TLS 1.3 with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | | An extension type standing twice is refused. | `Spec.rejects_duplicate_extension` | +| The hello of `Spec.accepts_psk_last` with pre_shared_key first is refused. | `Spec.rejects_psk_not_last` | | An extension length running past the block is refused. | `Spec.rejects_extension_overrun` | | A key share group standing twice is refused. | `Spec.rejects_duplicate_key_share_group` | | A key share entry with empty key bytes is refused. | `Spec.rejects_key_share_empty_key` | @@ -88,7 +91,8 @@ their fields, SNI has distinct entry types and a nonempty host name when present, ALPN names are nonempty, key share groups are distinct with nonempty keys, and an opaque extension's type is none of the four decoded -types); no extension type stands twice; the printed +types); no extension type stands twice; no extension but +the last has type 41 (pre_shared_key); the printed extensions block fits two bytes of length; and the printed handshake message, its four header bytes and the body fields, is at most 2^14 = 16384 bytes, the record diff --git a/SPEC.md b/SPEC.md index 05d579e..37b8f16 100644 --- a/SPEC.md +++ b/SPEC.md @@ -84,6 +84,14 @@ that many value bytes. An extension length running past the end of the block rejects, and the block must be consumed exactly. A duplicate extension type rejects. +pre_shared_key (type 41), when present, must be the last +extension. RFC 8446 section 4.2 says it "MUST be the last +extension in the ClientHello", and section 4.2.11 says +servers "MUST check that it is the last extension", so a +block in which type 41 stands anywhere but last rejects. +Its value is carried opaque, like every type not decoded +below. + Four types are decoded. Every other type is carried as the pair of its type and its raw value bytes, length checked, not interpreted. @@ -181,6 +189,8 @@ each rule on many more inputs. | A TLS 1.3 hello whose key_share carries no entries, as a client asking for a HelloRetryRequest sends it, is accepted | `Spec.accepts_key_share_empty_list` | | A hello that does not offer TLS 1.3 may list compression methods besides null | `Spec.accepts_tls12_compression` | | An accepted hello that offers TLS 1.3 has exactly the compression methods [0] | `Spec.tls13_compression_null` | +| A hello whose last extension is pre_shared_key is accepted | `Spec.accepts_psk_last` | +| In an accepted hello, pre_shared_key, when present, is the last extension | `Spec.psk_last` | | Empty input is refused | `Spec.rejects_empty` | | Input shorter than the record header is refused | `Spec.rejects_short_header` | | A record length of 0 is refused | `Spec.rejects_record_length_zero` | @@ -198,6 +208,7 @@ each rule on many more inputs. | An empty compression method list is refused | `Spec.rejects_empty_compression` | | A hello that offers TLS 1.3 with compression methods [1, 0] is refused | `Spec.rejects_tls13_compression` | | A duplicate extension type is refused | `Spec.rejects_duplicate_extension` | +| A hello with pre_shared_key before another extension is refused | `Spec.rejects_psk_not_last` | | An extension length running past the block is refused | `Spec.rejects_extension_overrun` | | A duplicate key share group is refused | `Spec.rejects_duplicate_key_share_group` | | A key share entry with empty key bytes is refused | `Spec.rejects_key_share_empty_key` | @@ -223,6 +234,11 @@ This is the reader model used across the sibling slices. no Certificate, no Finished. - No handshake crypto: no key schedule, no transcript hash, no signature checking. +- No rules that tie one extension to another beyond those + above. For example, the slice does not check that a + pre_shared_key comes with psk_key_exchange_modes (RFC + 8446 section 4.2.9), or that each key share's group is + offered in supported_groups (section 4.2.8). - No certificate work of any kind, and no matching of the server name against a certificate. That matching belongs to the hostname work; this slice only carries the name diff --git a/Spec.lean b/Spec.lean index df49fc0..83c0734 100644 --- a/Spec.lean +++ b/Spec.lean @@ -49,6 +49,13 @@ theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} (h13 : offersTls13 m.hello.extensions = true) : m.hello.compressionMethods = [0] := sorry +/-- In an accepted hello, no extension but the last has type 41 + (pre_shared_key): when present, pre_shared_key is the last extension + (RFC 8446 section 4.2.11). -/ +theorem Spec.psk_last {bs : List UInt8} {m : Message} + (hparse : parse bs = some m) : + 41 ∉ (m.hello.extensions.dropLast).map extType := sorry + /-! ## Accepted examples Single inputs the parser accepts. Each one is stated in the form the @@ -81,6 +88,13 @@ theorem Spec.accepts_tls12_compression : (parse ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8)).map print = some ([22, 3, 1, 0, 48, 1, 0, 0, 44, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 0] : List UInt8) := sorry +/-- A hello whose last extension is pre_shared_key (type 41, its value + carried opaque, here two bytes) after supported_versions is accepted + and writes back as the same bytes. -/ +theorem Spec.accepts_psk_last : + (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8)).map print = + some ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8) := sorry + /-! ## Refused inputs Single inputs the parser refuses, one for each headline rule of @@ -163,6 +177,11 @@ theorem Spec.rejects_tls13_compression : theorem Spec.rejects_duplicate_extension : (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := sorry +/-- The hello of `Spec.accepts_psk_last` with its two extensions in the + other order, pre_shared_key first, is refused. -/ +theorem Spec.rejects_psk_not_last : + (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 41, 0, 2, 0, 0, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry + /-- An extension length that runs past the end of the block is refused. -/ theorem Spec.rejects_extension_overrun : (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 0, 0, 10, 2, 3, 4] : List UInt8)).isSome = false := sorry diff --git a/comparator.json b/comparator.json index 647df26..3e476fc 100644 --- a/comparator.json +++ b/comparator.json @@ -5,10 +5,12 @@ "Spec.parse_print", "Spec.print_parse", "Spec.tls13_compression_null", + "Spec.psk_last", "Spec.accepts_empty_extensions", "Spec.accepts_supported_versions", "Spec.accepts_key_share_empty_list", "Spec.accepts_tls12_compression", + "Spec.accepts_psk_last", "Spec.rejects_empty", "Spec.rejects_short_header", "Spec.rejects_record_length_zero", @@ -26,6 +28,7 @@ "Spec.rejects_empty_compression", "Spec.rejects_tls13_compression", "Spec.rejects_duplicate_extension", + "Spec.rejects_psk_not_last", "Spec.rejects_extension_overrun", "Spec.rejects_duplicate_key_share_group", "Spec.rejects_key_share_empty_key", diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 5fc60bd..4e8110d 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -13,15 +13,15 @@ Python's ssl module cannot build a ClientHello on demand. Go is not installed (` | part | run | agreed | | --- | --- | --- | -| named cases | 36 | 36 | +| named cases | 39 | 39 | | generated messages | 3200 | 3200 | | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | | hellos near the 2^14 record limit | 60 | 60 | | malformed request lines | 7 | 7 | -| total | 4911 | 4911 | +| total | 4914 | 4914 | -Of the 3200 generated messages, the oracle accepts 1199 and rejects 2001. +Of the 3200 generated messages, the oracle accepts 1266 and rejects 1934. ## Named cases @@ -42,6 +42,9 @@ Of the 3200 generated messages, the oracle accepts 1199 and rejects 2001. - TLS 1.3 hello with compression methods 00 00: reject (62 bytes) - TLS 1.2 hello (supported_versions 0x0303 only) with compression methods 01 00, accepted: accept (60 bytes) - hello without extensions, compression methods 01 00, accepted: accept (53 bytes) +- pre_shared_key last, after key_share, accepted: accept (157 bytes) +- pre_shared_key before key_share: reject (157 bytes) +- pre_shared_key first of two: reject (109 bytes) - missing extensions block: reject (50 bytes) - supported versions odd length: reject (60 bytes) - supported versions length zero: reject (57 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index 2d52835..5cc98df 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -204,6 +204,10 @@ def oracle_exts(block): seen.add(t) ext, _ = oracle_ext_value(t, bytes(v)) exts.append((t, ext)) + # RFC 8446 section 4.2.11: pre_shared_key (41) must be the + # last extension in the ClientHello. + if 41 in [t for t, _ in exts[:-1]]: + raise Reject() return exts @@ -340,6 +344,14 @@ def ks_value(shares): return be16(len(body)) + body +def psk_value(identity=b"abc", binder=bytes(range(32))): + """A pre_shared_key value: one identity with a ticket age, + and one binder. The parser carries it opaque.""" + ident = be16(len(identity)) + identity + b"\x00\x00\x00\x07" + binders = bytes([len(binder)]) + binder + return be16(len(ident)) + ident + be16(len(binders)) + binders + + def ext_bytes(t, v): return be16(t) + be16(len(v)) + v @@ -480,6 +492,24 @@ def named_cases(): cases.append(("hello without extensions, compression methods " "01 00, accepted", build_hello(comps=(1, 0)), True)) + cases.append(("pre_shared_key last, after key_share, accepted", + build_hello(exts=[ + (43, sv_value([0x0304])), + (51, ks_value([(29, bytes(32))])), + (45, b"\x01\x01"), + (41, psk_value())]), + True)) + cases.append(("pre_shared_key before key_share", + build_hello(exts=[ + (43, sv_value([0x0304])), + (41, psk_value()), + (51, ks_value([(29, bytes(32))])), + (45, b"\x01\x01")]), + False)) + cases.append(("pre_shared_key first of two", + build_hello(exts=[(41, psk_value()), + (43, sv_value([0x0304]))]), + False)) cases.append(("missing extensions block", build_hello(ext_block=False), False)) cases.append(("supported versions odd length", @@ -607,10 +637,13 @@ def gen_ks(rng, defect): def gen_opaque(rng, taken): - choices = [t for t in [5, 10, 11, 13, 21, 23, 35, 42, 44, - 45, 49, 50, 300, 1000, 65281] + choices = [t for t in [5, 10, 11, 13, 21, 23, 35, 41, 42, + 44, 45, 49, 50, 300, 1000, 65281] if t not in taken] t = rng.choice(choices) + if t == 41 and rng.random() < 0.5: + return (t, psk_value(bytes(rng.randrange(256) + for _ in range(rng.randrange(1, 9))))) v = bytes(rng.randrange(256) for _ in range(rng.choice([0, 1, 4, 17, 40]))) return (t, v) From 954e47baf189efc2a739676168f0a81423aae9c0 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:13:19 +0000 Subject: [PATCH 08/19] Make seven refusal statements exercise their rule, and word every example as one input Review of e4c149a, non-blocking note: seven refusal statements stopped right after the field under test, so a parser without the named rule still refused them, and the README and SPEC tables paired them with general claims that the theorems do not back. Spec.lean, with the same names, proofs (decide +kernel) and comparator.json entries: - rejects_content_type, rejects_handshake_type, rejects_session_id_33, rejects_odd_cipher_suites and rejects_empty_cipher_suites now use the 61-byte hello of Spec.accepts_supported_versions with only that field changed (and the lengths that cover it). - rejects_compression_without_null and rejects_empty_compression now use the 52-byte hello of Spec.accepts_empty_extensions with only the compression methods changed. That hello offers no TLS 1.3, so the TLS 1.3 compression rule does not apply. A Python reading of SPEC.md with one rule removed at a time accepts each of the first six inputs, so each one is refused by its own rule. The empty compression list is the exception: an empty list holds no null method, so the null-method rule refuses it as well. No input can separate the two rules, and the statement's doc comment and the page say so. README "What is proved" and SPEC.md "Properties and their theorems" now split the claims into statements about every input and statements about single inputs. Each single-input claim says what its input is, for example "the hello of Spec.accepts_supported_versions with content type 23 in place of 22 is refused", rather than claiming the rule for every input. A sentence explains that the two round trips together fix the accepted set as the printed forms of well formed messages. The first item of README "What is not proved" now says what is unproved relative to that predicate: that WF matches SPEC.md. A new item says that no theorem names the bytes of each field (review 1 finding 5). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/SpecProofs.lean | 14 +++--- README.md | 102 +++++++++++++++++++++++++---------------- SPEC.md | 82 ++++++++++++++++++--------------- Spec.lean | 38 +++++++++------ 4 files changed, 140 insertions(+), 96 deletions(-) diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index bafcc68..0e8cf20 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -83,7 +83,7 @@ theorem Spec.rejects_record_length_zero : theorem Spec.rejects_content_type : - (parse ([23, 3, 1, 0, 0] : List UInt8)).isSome = false := by + (parse ([23, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by decide +kernel @@ -112,7 +112,7 @@ theorem Spec.rejects_trailing_bytes : theorem Spec.rejects_handshake_type : - (parse ([22, 3, 1, 0, 4, 2, 0, 0, 0] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 56, 2, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by decide +kernel @@ -127,27 +127,27 @@ theorem Spec.rejects_missing_extensions : theorem Spec.rejects_session_id_33 : - (parse ([22, 3, 1, 0, 39, 1, 0, 0, 35, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 89, 1, 0, 0, 85, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by decide +kernel theorem Spec.rejects_odd_cipher_suites : - (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3, 19, 1, 19, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by decide +kernel theorem Spec.rejects_empty_cipher_suites : - (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := by decide +kernel theorem Spec.rejects_compression_without_null : - (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1, 0, 0] : List UInt8)).isSome = false := by decide +kernel theorem Spec.rejects_empty_compression : - (parse ([22, 3, 1, 0, 44, 1, 0, 0, 40, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0] : List UInt8)).isSome = false := by + (parse ([22, 3, 1, 0, 46, 1, 0, 0, 42, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0, 0, 0] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index 6c6c8b0..e0350c4 100644 --- a/README.md +++ b/README.md @@ -41,43 +41,62 @@ where they end in `sorry`) and proved in `Proofs/SpecProofs.lean`, under the same names. `comparator.json` lists all of them. +Statements about every input: + | Claim | Theorem | |-------|---------| | Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | -| A hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | -| A minimal hello carrying only supported_versions is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | -| A TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | -| A hello that does not offer TLS 1.3 may list compression methods besides null: one with [1, 0] and no extensions is accepted and writes back as the same bytes. | `Spec.accepts_tls12_compression` | +| A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | | Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | -| A hello whose last extension is pre_shared_key is accepted and writes back as the same bytes. | `Spec.accepts_psk_last` | | In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | + +Together, the two round trips say that the parser accepts +exactly the printed forms of well formed messages, so every +rule that is part of well formedness (below) holds for +every accepted input. The three statements after them state +three of those rules on their own, so that each has a +theorem of its own. + +Single inputs. Each theorem below is about the one input +written out in `Spec.lean`, and each claim says what that +input is. Most refused inputs are an accepted input with +one field changed, so that the field's rule is what refuses +it. These theorems pin each rule to a concrete case; they +do not state the rule for every input. + +| Claim | Theorem | +|-------|---------| +| A 52-byte hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | +| A 61-byte hello whose one extension is supported_versions [0x0304, 0x0303] is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | +| An 83-byte TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | +| The hello of `Spec.accepts_empty_extensions` with compression methods [1, 0] is accepted and writes back as the same bytes: it does not offer TLS 1.3, so methods besides null may be listed. | `Spec.accepts_tls12_compression` | +| A hello whose extensions are supported_versions and then pre_shared_key is accepted and writes back as the same bytes. | `Spec.accepts_psk_last` | | Empty input is refused. | `Spec.rejects_empty` | -| Input shorter than the record header is refused. | `Spec.rejects_short_header` | -| A record length of 0 is refused. | `Spec.rejects_record_length_zero` | -| A content type other than 22 is refused. | `Spec.rejects_content_type` | -| A record length longer than the input is refused. | `Spec.rejects_record_length_longer` | -| A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | -| Bytes after the record are refused. | `Spec.rejects_trailing_bytes` | -| A handshake type other than 1 is refused. | `Spec.rejects_handshake_type` | -| A handshake length that does not match the body is refused. | `Spec.rejects_handshake_length` | -| A body with no extensions block is refused. | `Spec.rejects_missing_extensions` | -| A session id length of 33 is refused. | `Spec.rejects_session_id_33` | -| A cipher suite list with an odd byte length is refused. | `Spec.rejects_odd_cipher_suites` | -| An empty cipher suite list is refused. | `Spec.rejects_empty_cipher_suites` | -| Compression methods without the null method 0 are refused. | `Spec.rejects_compression_without_null` | -| An empty compression method list is refused. | `Spec.rejects_empty_compression` | -| A hello that offers TLS 1.3 with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | -| An extension type standing twice is refused. | `Spec.rejects_duplicate_extension` | -| The hello of `Spec.accepts_psk_last` with pre_shared_key first is refused. | `Spec.rejects_psk_not_last` | -| An extension length running past the block is refused. | `Spec.rejects_extension_overrun` | -| A key share group standing twice is refused. | `Spec.rejects_duplicate_key_share_group` | -| A key share entry with empty key bytes is refused. | `Spec.rejects_key_share_empty_key` | -| A supported_versions value with an odd length is refused. | `Spec.rejects_supported_versions_odd` | -| A supported_versions value with length 0 is refused. | `Spec.rejects_supported_versions_zero` | -| An ALPN value with an empty protocol name is refused. | `Spec.rejects_alpn_empty_name` | -| A server_name value with two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | -| A server_name list length that does not cover the value is refused. | `Spec.rejects_sni_list_length` | +| A 2-byte input, shorter than the record header, is refused. | `Spec.rejects_short_header` | +| A record header with length 0 and nothing after it is refused. | `Spec.rejects_record_length_zero` | +| The hello of `Spec.accepts_supported_versions` with content type 23 in place of 22 is refused. | `Spec.rejects_content_type` | +| A record whose length field (10) is longer than the 4 bytes that follow is refused. | `Spec.rejects_record_length_longer` | +| The hello of `Spec.accepts_empty_extensions` with one byte after the record is refused. | `Spec.rejects_trailing_bytes` | +| The hello of `Spec.accepts_supported_versions` with handshake type 2 in place of 1 is refused. | `Spec.rejects_handshake_type` | +| The hello of `Spec.accepts_empty_extensions` with a handshake length one more than the body holds is refused. | `Spec.rejects_handshake_length` | +| The hello of `Spec.accepts_empty_extensions` without its extensions block, ending after the compression methods, is refused. | `Spec.rejects_missing_extensions` | +| The hello of `Spec.accepts_supported_versions` with a 33-byte session id is refused. | `Spec.rejects_session_id_33` | +| The hello of `Spec.accepts_supported_versions` with a 3-byte cipher suite list is refused. | `Spec.rejects_odd_cipher_suites` | +| The hello of `Spec.accepts_supported_versions` with an empty cipher suite list is refused. | `Spec.rejects_empty_cipher_suites` | +| The hello of `Spec.accepts_empty_extensions` with compression methods [1], without the null method, is refused. | `Spec.rejects_compression_without_null` | +| The hello of `Spec.accepts_empty_extensions` with an empty compression method list is refused. (An empty list holds no null method, so the rule above refuses it too.) | `Spec.rejects_empty_compression` | +| The hello of `Spec.accepts_supported_versions`, which offers TLS 1.3, with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | +| A hello with two supported_versions extensions is refused. | `Spec.rejects_duplicate_extension` | +| The hello of `Spec.accepts_psk_last` with its two extensions in the other order, pre_shared_key first, is refused. | `Spec.rejects_psk_not_last` | +| A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | +| A hello whose key_share carries two entries for group 29 is refused. | `Spec.rejects_duplicate_key_share_group` | +| A hello whose key_share entry has empty key exchange bytes is refused. | `Spec.rejects_key_share_empty_key` | +| A hello whose supported_versions value has the odd length 3 is refused. | `Spec.rejects_supported_versions_odd` | +| A hello whose supported_versions value has length 0 is refused. | `Spec.rejects_supported_versions_zero` | +| A hello whose ALPN value holds one protocol name of length 0 is refused. | `Spec.rejects_alpn_empty_name` | +| A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | +| A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | A message is well formed when the record version and the legacy version each fit two bytes; the random holds @@ -105,8 +124,8 @@ The two round trip theorems rest on the proofs in standard axioms only (`propext`, `Classical.choice`, `Quot.sound`), which a reader can confirm with `#print axioms`; `Proofs/Verify.lean` prints them at -build time. The example theorems are single inputs -checked in the kernel with `decide +kernel`. +build time. The single-input theorems are checked in the +kernel with `decide +kernel`. The command line tool in `Main.lean` calls `ClientHello.parse` and `ClientHello.print` directly, @@ -114,13 +133,18 @@ the same functions the theorems are about. ## What is not proved -- That the parser accepts every message the rules in - `SPEC.md` allow, and turns away every message they - forbid. The round trips do not need either, and the - example theorems pin single inputs only, so neither - holds in general as a proof. The differential tests in - `tests/` check that behaviour instead, and the results - file records the outcome, including any failure. +- That the well formedness predicate is the same as the + rules in `SPEC.md`. Relative to the predicate, the + accepted inputs are fixed exactly: the parser accepts + the printed forms of well formed messages and nothing + else. That the predicate holds every rule of `SPEC.md`, + and no other, is read by the reviewer and checked by the + differential tests in `tests/`, not proved. The + single-input theorems pin one input each. +- That the printer writes the byte layout the RFCs give. + The round trips relate the parser and the printer to + each other; the accepted examples pin some whole inputs, + but no theorem names the bytes of each field. - The meaning of any extension other than the four decoded ones. Every other extension is carried as its type and value bytes, and no per extension content rule diff --git a/SPEC.md b/SPEC.md index 37b8f16..8886349 100644 --- a/SPEC.md +++ b/SPEC.md @@ -180,43 +180,53 @@ and proved in `Proofs/SpecProofs.lean`. The example theorems are single inputs; the tests in `tests/` cover each rule on many more inputs. +Statements about every input: + +| Property | Theorem | +|-------|---------| +| Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | +| Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | +| A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | +| Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | +| In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | + +Single inputs, each about the one input written out in +`Spec.lean`. Most refused inputs are an accepted input with +one field changed, so that the field's rule is what refuses +it: + | Property | Theorem | -|----------|---------| -| Parsing the printed form of a well formed message gives the message back | `Spec.parse_print` | -| A message the parser took prints back to the bytes it was read from, and is well formed | `Spec.print_parse` | -| A present, empty extensions block is accepted | `Spec.accepts_empty_extensions` | -| A minimal hello with only supported_versions is accepted | `Spec.accepts_supported_versions` | -| A TLS 1.3 hello whose key_share carries no entries, as a client asking for a HelloRetryRequest sends it, is accepted | `Spec.accepts_key_share_empty_list` | -| A hello that does not offer TLS 1.3 may list compression methods besides null | `Spec.accepts_tls12_compression` | -| An accepted hello that offers TLS 1.3 has exactly the compression methods [0] | `Spec.tls13_compression_null` | -| A hello whose last extension is pre_shared_key is accepted | `Spec.accepts_psk_last` | -| In an accepted hello, pre_shared_key, when present, is the last extension | `Spec.psk_last` | -| Empty input is refused | `Spec.rejects_empty` | -| Input shorter than the record header is refused | `Spec.rejects_short_header` | -| A record length of 0 is refused | `Spec.rejects_record_length_zero` | -| A content type other than 22 is refused | `Spec.rejects_content_type` | -| A record length longer than the input is refused | `Spec.rejects_record_length_longer` | -| A record length above 2^14 = 16384 is refused, whatever else the input holds | `Spec.rejects_record_overflow` | -| Bytes after the record are refused | `Spec.rejects_trailing_bytes` | -| A handshake type other than 1 is refused | `Spec.rejects_handshake_type` | -| A handshake length that does not match the body is refused | `Spec.rejects_handshake_length` | -| A body with no extensions block is refused | `Spec.rejects_missing_extensions` | -| A session id length over 32 is refused | `Spec.rejects_session_id_33` | -| A cipher suite list with an odd byte length is refused | `Spec.rejects_odd_cipher_suites` | -| An empty cipher suite list is refused | `Spec.rejects_empty_cipher_suites` | -| Compression methods must contain the null method 0 | `Spec.rejects_compression_without_null` | -| An empty compression method list is refused | `Spec.rejects_empty_compression` | -| A hello that offers TLS 1.3 with compression methods [1, 0] is refused | `Spec.rejects_tls13_compression` | -| A duplicate extension type is refused | `Spec.rejects_duplicate_extension` | -| A hello with pre_shared_key before another extension is refused | `Spec.rejects_psk_not_last` | -| An extension length running past the block is refused | `Spec.rejects_extension_overrun` | -| A duplicate key share group is refused | `Spec.rejects_duplicate_key_share_group` | -| A key share entry with empty key bytes is refused | `Spec.rejects_key_share_empty_key` | -| A supported_versions value with an odd length is refused | `Spec.rejects_supported_versions_odd` | -| A supported_versions value with length 0 is refused | `Spec.rejects_supported_versions_zero` | -| An ALPN value with an empty protocol name is refused | `Spec.rejects_alpn_empty_name` | -| A server_name value with two host_name entries is refused | `Spec.rejects_sni_second_host_name` | -| A server_name list length that does not cover the value is refused | `Spec.rejects_sni_list_length` | +|-------|---------| +| A 52-byte hello with a present, empty extensions block is accepted and writes back as the same bytes. | `Spec.accepts_empty_extensions` | +| A 61-byte hello whose one extension is supported_versions [0x0304, 0x0303] is accepted and writes back as the same bytes. | `Spec.accepts_supported_versions` | +| An 83-byte TLS 1.3 hello whose key_share carries no entries, the form a client uses to ask for a HelloRetryRequest, is accepted and writes back as the same bytes. | `Spec.accepts_key_share_empty_list` | +| The hello of `Spec.accepts_empty_extensions` with compression methods [1, 0] is accepted and writes back as the same bytes: it does not offer TLS 1.3, so methods besides null may be listed. | `Spec.accepts_tls12_compression` | +| A hello whose extensions are supported_versions and then pre_shared_key is accepted and writes back as the same bytes. | `Spec.accepts_psk_last` | +| Empty input is refused. | `Spec.rejects_empty` | +| A 2-byte input, shorter than the record header, is refused. | `Spec.rejects_short_header` | +| A record header with length 0 and nothing after it is refused. | `Spec.rejects_record_length_zero` | +| The hello of `Spec.accepts_supported_versions` with content type 23 in place of 22 is refused. | `Spec.rejects_content_type` | +| A record whose length field (10) is longer than the 4 bytes that follow is refused. | `Spec.rejects_record_length_longer` | +| The hello of `Spec.accepts_empty_extensions` with one byte after the record is refused. | `Spec.rejects_trailing_bytes` | +| The hello of `Spec.accepts_supported_versions` with handshake type 2 in place of 1 is refused. | `Spec.rejects_handshake_type` | +| The hello of `Spec.accepts_empty_extensions` with a handshake length one more than the body holds is refused. | `Spec.rejects_handshake_length` | +| The hello of `Spec.accepts_empty_extensions` without its extensions block, ending after the compression methods, is refused. | `Spec.rejects_missing_extensions` | +| The hello of `Spec.accepts_supported_versions` with a 33-byte session id is refused. | `Spec.rejects_session_id_33` | +| The hello of `Spec.accepts_supported_versions` with a 3-byte cipher suite list is refused. | `Spec.rejects_odd_cipher_suites` | +| The hello of `Spec.accepts_supported_versions` with an empty cipher suite list is refused. | `Spec.rejects_empty_cipher_suites` | +| The hello of `Spec.accepts_empty_extensions` with compression methods [1], without the null method, is refused. | `Spec.rejects_compression_without_null` | +| The hello of `Spec.accepts_empty_extensions` with an empty compression method list is refused. (An empty list holds no null method, so the rule above refuses it too.) | `Spec.rejects_empty_compression` | +| The hello of `Spec.accepts_supported_versions`, which offers TLS 1.3, with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | +| A hello with two supported_versions extensions is refused. | `Spec.rejects_duplicate_extension` | +| The hello of `Spec.accepts_psk_last` with its two extensions in the other order, pre_shared_key first, is refused. | `Spec.rejects_psk_not_last` | +| A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | +| A hello whose key_share carries two entries for group 29 is refused. | `Spec.rejects_duplicate_key_share_group` | +| A hello whose key_share entry has empty key exchange bytes is refused. | `Spec.rejects_key_share_empty_key` | +| A hello whose supported_versions value has the odd length 3 is refused. | `Spec.rejects_supported_versions_odd` | +| A hello whose supported_versions value has length 0 is refused. | `Spec.rejects_supported_versions_zero` | +| A hello whose ALPN value holds one protocol name of length 0 is refused. | `Spec.rejects_alpn_empty_name` | +| A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | +| A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | ## Safety diff --git a/Spec.lean b/Spec.lean index 83c0734..7727cb3 100644 --- a/Spec.lean +++ b/Spec.lean @@ -114,9 +114,10 @@ theorem Spec.rejects_short_header : theorem Spec.rejects_record_length_zero : (parse ([22, 3, 1, 0, 0] : List UInt8)).isSome = false := sorry -/-- A content type other than 22 (handshake) is refused. -/ +/-- The hello of `Spec.accepts_supported_versions` with content type 23 + (application_data) in place of 22 is refused. -/ theorem Spec.rejects_content_type : - (parse ([23, 3, 1, 0, 0] : List UInt8)).isSome = false := sorry + (parse ([23, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry /-- A record length longer than the input is refused rather than read past the end. -/ theorem Spec.rejects_record_length_longer : @@ -134,9 +135,10 @@ theorem Spec.rejects_record_overflow (ct v1 v2 a b : UInt8) theorem Spec.rejects_trailing_bytes : (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 0, 0] : List UInt8)).isSome = false := sorry -/-- A handshake type other than 1 (client_hello) is refused. -/ +/-- The hello of `Spec.accepts_supported_versions` with handshake type 2 + (server_hello) in place of 1 is refused. -/ theorem Spec.rejects_handshake_type : - (parse ([22, 3, 1, 0, 4, 2, 0, 0, 0] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 56, 2, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry /-- A handshake length that does not equal the remaining body length is refused. -/ theorem Spec.rejects_handshake_length : @@ -146,25 +148,33 @@ theorem Spec.rejects_handshake_length : theorem Spec.rejects_missing_extensions : (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0] : List UInt8)).isSome = false := sorry -/-- A session id length of 33 is refused: the limit is 32. -/ +/-- The hello of `Spec.accepts_supported_versions` with a 33-byte session + id, one over the limit of 32, is refused. Only the session id and the + lengths that cover it differ. -/ theorem Spec.rejects_session_id_33 : - (parse ([22, 3, 1, 0, 39, 1, 0, 0, 35, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 89, 1, 0, 0, 85, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 33, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry -/-- A cipher suite list with an odd byte length is refused. -/ +/-- The hello of `Spec.accepts_supported_versions` with a 3-byte cipher + suite list (19, 1, 19), an odd length, is refused. -/ theorem Spec.rejects_odd_cipher_suites : - (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 3, 19, 1, 19, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry -/-- An empty cipher suite list is refused. -/ +/-- The hello of `Spec.accepts_supported_versions` with an empty cipher + suite list is refused. -/ theorem Spec.rejects_empty_cipher_suites : - (parse ([22, 3, 1, 0, 41, 1, 0, 0, 37, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 0, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry -/-- Compression methods that do not contain the null method 0 are refused. -/ +/-- The hello of `Spec.accepts_empty_extensions` with compression methods + [1], which lack the null method 0, is refused. It offers no TLS 1.3, + so only the null method rule applies. -/ theorem Spec.rejects_compression_without_null : - (parse ([22, 3, 1, 0, 45, 1, 0, 0, 41, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 47, 1, 0, 0, 43, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 1, 0, 0] : List UInt8)).isSome = false := sorry -/-- An empty compression method list is refused. -/ +/-- The hello of `Spec.accepts_empty_extensions` with an empty compression + method list is refused. An empty list holds no null method, so the + rule of `Spec.rejects_compression_without_null` refuses it as well. -/ theorem Spec.rejects_empty_compression : - (parse ([22, 3, 1, 0, 44, 1, 0, 0, 40, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0] : List UInt8)).isSome = false := sorry + (parse ([22, 3, 1, 0, 46, 1, 0, 0, 42, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 0, 0, 0] : List UInt8)).isSome = false := sorry /-- A hello that offers TLS 1.3 and lists compression methods [1, 0] is refused: for TLS 1.3 the list must be exactly [0]. The input is the From 515921fd325ece6dc6f284d82294e54a52b5d897 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:15:37 +0000 Subject: [PATCH 09/19] Test record: Oracle, Seed, Inputs and Failures lines, and real OpenSSL hellos Review of e4c149a, non-blocking note, and review 1 finding 6: - check.py left item 5 OPEN because tests/TEST-RESULTS.md had no "- Oracle:", "- Seed:", "- Inputs:" or "- Failures:" lines. The record now opens with them, and with the command that made it. - The record, the harness docstring and the PR said that Python's ssl module cannot build a ClientHello. That is wrong: a client SSLObject over two MemoryBIOs writes its hello on the first do_handshake(), with no network. The harness now does this for 12 fixed settings, two hellos each (TLS 1.2 only, TLS 1.3 only, both; with and without SNI and ALPN; a cipher list, a single group, post-handshake auth). Each of the 24 must be accepted and printed back byte for byte, and is (OpenSSL 3.0.13 here). - The record also said Go is not installed. That is not true on this machine, so it is dropped. The record now says what is run: OpenSSL supplies real accepted hellos, and no outside TLS stack judges the malformed inputs. - The harness oracle was called "an independent implementation". It is a second reading of SPEC.md by the same authors, and the record, the docstring and README "What you must trust" now say so. The run gives 4,938 inputs and 0 failures, with seed 20261026. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 17 +++-- tests/TEST-RESULTS.md | 14 ++-- tests/run_tests.py | 165 +++++++++++++++++++++++++++++++++--------- 3 files changed, 151 insertions(+), 45 deletions(-) diff --git a/README.md b/README.md index e0350c4..3f0662e 100644 --- a/README.md +++ b/README.md @@ -29,8 +29,9 @@ parses, `none` when it is rejected, and `error` when the request itself is malformed. `python3 tests/run_tests.py` rebuilds, runs the fixed -cases, the named rejections, and the differential run -against the harness oracle, and writes the outcome to +cases, the named rejections, the differential run against +the harness oracle, and real ClientHellos built by OpenSSL +through Python's ssl module, and writes the outcome to `tests/TEST-RESULTS.md`. ## What is proved @@ -173,8 +174,11 @@ the same functions the theorems are about. the spec to the RFCs is a reading, pinned in SPEC.md where the RFCs leave a choice open. - The test oracle in `tests/run_tests.py` is a second - reading of the same rules, in Python. It is evidence, - not proof. + reading of the same rules, in Python, by the same + authors. It is evidence, not proof. OpenSSL, through + Python's ssl module, supplies real ClientHellos that must + be accepted, but no outside TLS stack judges the + malformed inputs. - The line handling in `Main.lean` (splitting a request line, reading decimal codes). The tests drive it, and no proof covers it. @@ -191,8 +195,9 @@ the same functions the theorems are about. accepted by Lean's kernel and every other kernel shipped with Lean. 2. `python3 tests/run_tests.py`: the fixed cases, the - named rejections, and the differential run against - the oracle, with counts and any failures written to + named rejections, the differential run against the + oracle, and the OpenSSL-built hellos, with the oracle, + seed, input count and failures written to `tests/TEST-RESULTS.md`. 3. `lake build`: the library, the proofs, and the tool build clean, and the build prints the axiom list for diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 4e8110d..1f8c70e 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -1,13 +1,16 @@ # ClientHello slice: test results -Run: python3 tests/run_tests.py --seed 20261026 --count 3200 -Seed: 20261026. Python 3.13.17. +- Oracle: the harness oracle in tests/run_tests.py, a second reading of SPEC.md in Python 3.13.17, for every input; and OpenSSL 3.0.13 30 Jan 2024 through Python's ssl module, which built 24 of the inputs as real ClientHellos that must be accepted and printed back byte for byte +- Seed: 20261026 +- Inputs: 4938 +- Failures: 0 +- Command: python3 tests/run_tests.py --seed 20261026 --count 3200 ## Oracles -Every verdict is settled by the harness oracle, a Python implementation of the rules in SPEC.md written for these tests. The tool must agree with the oracle on every input, and an accepted message must reprint to the oracle's canonical reprint byte for byte. +Every verdict is settled by the harness oracle, a Python implementation of the rules in SPEC.md written for these tests. It is a second reading by the same authors, not an independent implementation. The tool must agree with it on every input, and an accepted message must print back to the oracle's canonical form byte for byte. -Python's ssl module cannot build a ClientHello on demand. Go is not installed (`go version` fails). Scapy 2.8.0 is present in the sibling dhcp project's venv and its TLS submodules import, but building or dissecting a TLS record raises NameError inside scapy's crypto support (HMAC is not defined), so Scapy could not be used as a byte source. No capture was fetched; the fixed cases are built by hand from the RFCs. +Python's ssl module builds real ClientHellos in memory: a client SSLObject over two MemoryBIOs writes its hello on the first do_handshake(). The run makes 24 of them with OpenSSL 3.0.13 30 Jan 2024, two under each of 12 settings (TLS 1.2 only, TLS 1.3 only, both; with and without SNI and ALPN; a cipher list, a single group, post-handshake auth). Each must be accepted and printed back unchanged. Their random bytes and key shares differ from run to run; their count and settings do not. OpenSSL is a source of real accepted inputs here, not a verdict oracle: no TLS stack is asked to judge the malformed inputs, so the verdicts on those rest on the harness oracle alone. The other fixed cases are built by hand from the RFCs. ## Counts @@ -18,8 +21,9 @@ Python's ssl module cannot build a ClientHello on demand. Go is not installed (` | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | | hellos near the 2^14 record limit | 60 | 60 | +| ClientHellos built by OpenSSL | 24 | 24 | | malformed request lines | 7 | 7 | -| total | 4914 | 4914 | +| total | 4938 | 4938 | Of the 3200 generated messages, the oracle accepts 1266 and rejects 1934. diff --git a/tests/run_tests.py b/tests/run_tests.py index 5cc98df..8282ef0 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -23,18 +23,19 @@ and fully random byte strings. The oracle settles every verdict; the tool must agree with it on each input. -3. Malformed request lines must be answered `error`. - -Oracle availability, checked when this harness was written -and stated again in the results record: Python's ssl module -cannot build a ClientHello on demand. Go is not installed -(`go version` fails). Scapy 2.8.0 is importable from the -sibling dhcp project's venv and its TLS submodules import, -but building or dissecting a TLS record raises NameError -inside scapy's crypto support (HMAC is not defined), so -Scapy cannot serve as a byte source in this environment and -was not used. No captured ClientHello was fetched; the -fixed cases are built by hand from the RFCs. +3. Real ClientHellos built by OpenSSL through Python's ssl + module, under a fixed list of settings. A client SSLObject + over two MemoryBIOs writes its hello on the first + do_handshake(), with no network. Each must be accepted and + printed back byte for byte. OpenSSL is used here only as a + source of real hellos; its verdicts on malformed input are + not compared. + +4. Malformed request lines must be answered `error`. + +The harness oracle is a second reading of SPEC.md, written +for these tests by the same authors. It is not an +independent implementation, and the results record says so. python3 tests/run_tests.py [--seed N] [--count N] @@ -60,9 +61,10 @@ # ---------------------------------------------------------------- -# The oracle: an independent implementation of the SPEC rules. -# It parses bytes into a model and reprints the model; the -# reprint of an accepted message is the expected tool answer. +# The oracle: a second implementation of the SPEC rules, written +# for these tests. It parses bytes into a model and reprints the +# model; the reprint of an accepted message is the expected tool +# answer. # ---------------------------------------------------------------- class Reject(Exception): @@ -740,6 +742,75 @@ def gen_random_raw(rng): return out +# ---------------------------------------------------------------- +# Real ClientHellos, built by OpenSSL through Python's ssl module. +# ---------------------------------------------------------------- + +OPENSSL_SETTINGS = [ + ("TLS 1.2 and 1.3, SNI example.com, ALPN h2 and http/1.1", + dict(sni="example.com", alpn=["h2", "http/1.1"])), + ("TLS 1.2 and 1.3, SNI example.com", dict(sni="example.com")), + ("TLS 1.2 and 1.3, no SNI", dict()), + ("TLS 1.3 only, SNI example.com", + dict(sni="example.com", min="TLSv1_3")), + ("TLS 1.3 only, SNI a.b.example.org, ALPN h2", + dict(sni="a.b.example.org", min="TLSv1_3", alpn=["h2"])), + ("TLS 1.2 only, SNI example.com", + dict(sni="example.com", min="TLSv1_2", max="TLSv1_2")), + ("TLS 1.2 only, no SNI, ALPN http/1.1", + dict(min="TLSv1_2", max="TLSv1_2", alpn=["http/1.1"])), + ("TLS 1.2 and 1.3, SNI xn--bcher-kva.example", + dict(sni="xn--bcher-kva.example")), + ("TLS 1.2 and 1.3, SNI with a 63-byte label", + dict(sni="a" * 63 + ".example")), + ("TLS 1.2 and 1.3, cipher list ECDHE+AESGCM", + dict(sni="example.com", ciphers="ECDHE+AESGCM")), + ("TLS 1.2 and 1.3, group P-256 only", + dict(sni="example.com", curve="prime256v1")), + ("TLS 1.3 only, post-handshake auth", + dict(sni="example.com", min="TLSv1_3", pha=True)), +] + + +def openssl_hello(kw): + """The ClientHello record OpenSSL writes for these settings. + Its random and key shares are new on every call.""" + import ssl + ctx = ssl.SSLContext(ssl.PROTOCOL_TLS_CLIENT) + ctx.check_hostname = False + ctx.verify_mode = ssl.CERT_NONE + if "min" in kw: + ctx.minimum_version = getattr(ssl.TLSVersion, kw["min"]) + if "max" in kw: + ctx.maximum_version = getattr(ssl.TLSVersion, kw["max"]) + if "alpn" in kw: + ctx.set_alpn_protocols(kw["alpn"]) + if "ciphers" in kw: + ctx.set_ciphers(kw["ciphers"]) + if "curve" in kw: + ctx.set_ecdh_curve(kw["curve"]) + if kw.get("pha"): + ctx.post_handshake_auth = True + inc, out = ssl.MemoryBIO(), ssl.MemoryBIO() + obj = ctx.wrap_bio(inc, out, server_hostname=kw.get("sni")) + try: + obj.do_handshake() + except ssl.SSLWantReadError: + pass + return out.read() + + +def openssl_hellos(): + """Two hellos for each setting: (label, bytes) pairs.""" + return [(label, openssl_hello(kw)) + for label, kw in OPENSSL_SETTINGS for _ in range(2)] + + +def openssl_version(): + import ssl + return ssl.OPENSSL_VERSION + + # ---------------------------------------------------------------- # The runner. # ---------------------------------------------------------------- @@ -876,6 +947,15 @@ def main(): n, a = check_batch(near, "near the record limit", failures) tally["hellos near the 2^14 record limit"] = (n, a) + real = openssl_hellos() + for label, bs in real: + if oracle_parse(bs) != bs: + failures.append(f"OpenSSL hello ({label}): the oracle does " + f"not accept it and print it back unchanged") + n, a = check_batch([bs for _, bs in real], "OpenSSL hellos", + failures) + tally["ClientHellos built by OpenSSL"] = (n, a) + malformed = ["parse 256", "parse 1,x", "parse 1,,2", "peek 1,2", "parse -1", "parse 1 2", "parse 999999999999"] @@ -896,30 +976,47 @@ def main(): lines = [] lines.append("# ClientHello slice: test results") lines.append("") - lines.append(f"Run: python3 tests/run_tests.py " + lines.append(f"- Oracle: the harness oracle in tests/run_tests.py, " + f"a second reading of SPEC.md in Python " + f"{platform.python_version()}, for every input; and " + f"{openssl_version()} through Python's ssl module, " + f"which built {len(real)} of the inputs as real " + f"ClientHellos that must be accepted and printed " + f"back byte for byte") + lines.append(f"- Seed: {args.seed}") + lines.append(f"- Inputs: {total}") + lines.append(f"- Failures: {len(failures)}") + lines.append(f"- Command: python3 tests/run_tests.py " f"--seed {args.seed} --count {args.count}") - lines.append(f"Seed: {args.seed}. " - f"Python {platform.python_version()}.") lines.append("") lines.append("## Oracles") lines.append("") - lines.append("Every verdict is settled by the harness " - "oracle, a Python implementation of the rules " - "in SPEC.md written for these tests. The tool " - "must agree with the oracle on every input, " - "and an accepted message must reprint to the " - "oracle's canonical reprint byte for byte.") + lines.append("Every verdict is settled by the harness oracle, a " + "Python implementation of the rules in SPEC.md " + "written for these tests. It is a second reading " + "by the same authors, not an independent " + "implementation. The tool must agree with it on " + "every input, and an accepted message must print " + "back to the oracle's canonical form byte for " + "byte.") lines.append("") - lines.append("Python's ssl module cannot build a " - "ClientHello on demand. Go is not installed " - "(`go version` fails). Scapy 2.8.0 is present " - "in the sibling dhcp project's venv and its " - "TLS submodules import, but building or " - "dissecting a TLS record raises NameError " - "inside scapy's crypto support (HMAC is not " - "defined), so Scapy could not be used as a " - "byte source. No capture was fetched; the " - "fixed cases are built by hand from the RFCs.") + lines.append("Python's ssl module builds real ClientHellos in " + "memory: a client SSLObject over two MemoryBIOs " + "writes its hello on the first do_handshake(). The " + f"run makes {len(real)} of them with " + f"{openssl_version()}, two under each of " + f"{len(OPENSSL_SETTINGS)} settings (TLS 1.2 only, " + "TLS 1.3 only, both; with and without SNI and " + "ALPN; a cipher list, a single group, " + "post-handshake auth). Each must be accepted and " + "printed back unchanged. Their random bytes and " + "key shares differ from run to run; their count " + "and settings do not. OpenSSL is a source of real " + "accepted inputs here, not a verdict oracle: no " + "TLS stack is asked to judge the malformed inputs, " + "so the verdicts on those rest on the harness " + "oracle alone. The other fixed cases are built by " + "hand from the RFCs.") lines.append("") lines.append("## Counts") lines.append("") From d22d73005b2cb050497d71b98b622e480e7f0411 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:15:45 +0000 Subject: [PATCH 10/19] Page: status line says "in progress"; drop the unproved past-the-end claim - Review of e4c149a, non-blocking note: check.py left item 6 OPEN because README's status line said "in-progress" (the bar.toml spelling) where the page must say "in progress". It does now. - Review 1 finding 11: SPEC.md's Safety section, the Parse.lean header and the RoundTrip.lean header said that the parser never reads past the end of its input, but no theorem states that. In the list model every reader is a total function, so there is nothing to prove, and the sentence added nothing beyond print_parse. SPEC.md's section is now "Reading past the end". It says no theorem states this, explains why, and names what the theorems do say: print_parse, and the two refusals of lengths that run past the input. The two Lean headers say the same. In Spec.lean, the doc comments of rejects_record_length_longer and rejects_extension_overrun now describe their inputs instead of reading past the end. Statements are unchanged. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Parse.lean | 4 ++-- Proofs/RoundTrip.lean | 10 ++++++---- README.md | 2 +- SPEC.md | 24 +++++++++++++++--------- Spec.lean | 6 ++++-- 5 files changed, 28 insertions(+), 18 deletions(-) diff --git a/ClientHello/Parse.lean b/ClientHello/Parse.lean index 51b507a..6f8e10c 100644 --- a/ClientHello/Parse.lean +++ b/ClientHello/Parse.lean @@ -2,8 +2,8 @@ The TLS ClientHello parser. It reads one record holding one ClientHello and returns the message, or `none` when the bytes break any of the rules in SPEC.md. Every read is - length checked before it happens, so the parser never - reads past the end of its input: + length checked: a field read from input too short for it + gives `none`. The rules: - The record header is five bytes: content type 22, a legacy record version carried unchecked, and a two byte diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index f37f3f7..03e5c27 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -13,10 +13,12 @@ value, and the value holds every byte the message carried, so nothing is lost or added. - The parser's safety, that it never reads past the end of - its input, is in the shape of the readers: every read is a - `take` whose length is checked first, or a match on bytes - that must be present. SPEC.md states it. + No theorem here says the parser never reads past the end + of its input. In this list model every reader is a total + function, so there is no out of bounds read to rule out: a + read from input too short for its field gives `none`. The + statement about the bytes is `print_parse`: every byte of + an accepted input is accounted for in the message. -/ import ClientHello diff --git a/README.md b/README.md index 3f0662e..e43f8ed 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # clienthello: a TLS ClientHello parser and printer, with proved round trips -Status: in-progress +Status: in progress A parser and printer for the TLS ClientHello message, in Lean, following RFC 8446 section 4.1.2, with the legacy diff --git a/SPEC.md b/SPEC.md index 8886349..3bc8d1b 100644 --- a/SPEC.md +++ b/SPEC.md @@ -228,15 +228,21 @@ it: | A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | | A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | -## Safety - -The parser never reads past the end of its input. Every -read goes through the length checked readers (getU8, -getU16, getU24, getBytes): a read either takes bytes that -are present, checked against the remaining length, or -fails. The extension parsers run over a value already cut -to its declared length, so the same check bounds them. -This is the reader model used across the sibling slices. +## Reading past the end + +No theorem says the parser never reads past the end of its +input, and this page does not claim it as proved. In the +Lean model the input is a list and every reader is a total +function on lists, so there is no out of bounds read to +rule out: a field read from input too short for it gives +`none`, and the parser refuses. The extension parsers run +over a value already cut to its declared length. What the +theorems do say about the bytes is `Spec.print_parse`: +every byte of an accepted input is accounted for, since +the parsed message prints back to exactly that input. Lengths +that run past the input are refused in the cases of +`Spec.rejects_record_length_longer` and +`Spec.rejects_extension_overrun`, and the tests cover more. ## Slice boundaries diff --git a/Spec.lean b/Spec.lean index 7727cb3..4b45009 100644 --- a/Spec.lean +++ b/Spec.lean @@ -119,7 +119,8 @@ theorem Spec.rejects_record_length_zero : theorem Spec.rejects_content_type : (parse ([23, 3, 1, 0, 56, 1, 0, 0, 52, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry -/-- A record length longer than the input is refused rather than read past the end. -/ +/-- A record whose length field (10) is longer than the 4 bytes that follow + is refused. -/ theorem Spec.rejects_record_length_longer : (parse ([22, 3, 1, 0, 10, 1, 0, 0, 0] : List UInt8)).isSome = false := sorry @@ -192,7 +193,8 @@ theorem Spec.rejects_duplicate_extension : theorem Spec.rejects_psk_not_last : (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 41, 0, 2, 0, 0, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry -/-- An extension length that runs past the end of the block is refused. -/ +/-- A hello whose one extension declares 10 value bytes where its block + holds 3 is refused. -/ theorem Spec.rejects_extension_overrun : (parse ([22, 3, 1, 0, 54, 1, 0, 0, 50, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 7, 0, 0, 0, 10, 2, 3, 4] : List UInt8)).isSome = false := sorry From f362fab645319a80983c34c845e172c12efe5584 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:16:54 +0000 Subject: [PATCH 11/19] Build without warnings lake build printed 111 warnings, most of them already present at e4c149a: if_pos and if_neg are deprecated in Lean 4.35 in favour of ite_eq_left and ite_eq_right, which have the same statements, and 13 simp calls named lemmas they did not use. The proofs now use the new names and drop the unused simp arguments. No statement or definition changes. lake build now prints no warnings, all six kernels accept the comparator theorems, and the test run is unchanged (4,938 inputs, 0 failures). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/RoundTrip.lean | 222 ++++++++++++++++++++--------------------- Proofs/SpecProofs.lean | 6 +- 2 files changed, 114 insertions(+), 114 deletions(-) diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 03e5c27..5f03697 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -176,7 +176,7 @@ theorem withBytes_app {α : Type} {n : Nat} {v : List UInt8} rw [← hv]; exact List.take_left have hd : (v ++ r).drop n = r := by rw [← hv]; exact List.drop_left - rw [ht, hd, if_pos hv] + rw [ht, hd, ite_eq_left hv] /-- A block read at exactly its own length gives the block and nothing after it. -/ @@ -269,10 +269,10 @@ theorem withBytes_inv {α : Type} {n : Nat} {bs : List UInt8} ∃ v r, v.length = n ∧ bs = v ++ r ∧ k v r = some x := by unfold withBytes at h by_cases hc : (bs.take n).length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h exact ⟨bs.take n, bs.drop n, hc, (List.take_append_drop n bs).symm, h⟩ - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h cases h /-! ## Two byte value lists: the cipher suites and the @@ -468,7 +468,7 @@ theorem parseNameEntriesGo_print : bs.length.toUInt8, bs ++ printNameEntries es) = _ rw [u16_be16 bs.length (by omega)] rw [hg] - simp only [Option.bind_some] + simp only [] show (if ((bs ++ printNameEntries es).take bs.length).length = bs.length then parseNameEntriesGo f ((bs ++ printNameEntries es).drop @@ -477,12 +477,12 @@ theorem parseNameEntriesGo_print : else some (((t.toUInt8).toNat, (bs ++ printNameEntries es).take bs.length) :: es') else none) = some ((t, bs) :: es) - rw [List.take_left, List.drop_left, if_pos rfl, + rw [List.take_left, List.drop_left, ite_eq_left rfl, ih f htail hnodup' hf'] show (if (t.toUInt8).toNat ∈ es.map Prod.fst then none else some (((t.toUInt8).toNat, bs) :: es)) = some ((t, bs) :: es) - rw [if_neg (by rw [ht]; exact hnotin), ht] + rw [ite_eq_right (by rw [ht]; exact hnotin), ht] /-- Printed server name entries read back, at the top level. -/ @@ -530,15 +530,15 @@ theorem parseNameEntriesGo_inv : else none) = some es at h obtain ⟨hrest, hnlt⟩ := getU16_inv hn by_cases hc : (r1.take n).length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨es', hrec, h⟩ := Option.bind_eq_some_iff.mp h obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec by_cases hd : t.toNat ∈ es'.map Prod.fst - · rw [if_pos hd] at h + · rw [ite_eq_left hd] at h simp at h - · rw [if_neg hd] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h + · rw [ite_eq_right hd] at h + simp only [Option.some.injEq] at h obtain ⟨rfl, rfl⟩ := h refine ⟨?_, ?_, ?_⟩ · show printNameEntries ((t.toNat, r1.take n) :: es') @@ -560,7 +560,7 @@ theorem parseNameEntriesGo_inv : = t.toNat :: es'.map Prod.fst := rfl rw [h2] exact List.nodup_cons.mpr ⟨hd, hnodup⟩ - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-- Server name entries a successful read gives print back, @@ -635,16 +635,16 @@ theorem parseSNI_print {es : List (Nat × List UInt8)} printNameEntries es) = some (Extension.serverName es) unfold parseSNI rw [getU16_be16 _ (by omega)] - simp only [Option.bind_some] + simp only [] show (if (printNameEntries es).length = (printNameEntries es).length then parseNameEntries (printNameEntries es) >>= fun es' => if validNames es' then some (Extension.serverName es') else none else none) = some (Extension.serverName es) - rw [if_pos rfl, parseNameEntries_print hw' hnodup] + rw [ite_eq_left rfl, parseNameEntries_print hw' hnodup] show (if validNames es then some (Extension.serverName es) else none) = some (Extension.serverName es) - rw [if_pos (validNames_of hne (fun e he => (hw e he).2.2))] + rw [ite_eq_left (validNames_of hne (fun e he => (hw e he).2.2))] /-- A server_name value a successful read gives is the printed form of the extension it gives, and the @@ -664,10 +664,10 @@ theorem parseSNI_inv {v : List UInt8} {e : Extension} else none) = some e at h obtain ⟨hrest, hnlt⟩ := getU16_inv hn by_cases hc : rest.length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨es, hrec, h⟩ := Option.bind_eq_some_iff.mp h by_cases hval : validNames es = true - · rw [if_pos hval] at h + · rw [ite_eq_left hval] at h simp only [Option.some.injEq] at h subst h obtain ⟨hprint, hprops, hnodup⟩ := parseNameEntries_inv hrec @@ -684,9 +684,9 @@ theorem parseSNI_inv {v : List UInt8} {e : Extension} have hvlen : v.length = rest.length + 2 := by rw [hrest]; simp [be16] omega⟩ - · rw [if_neg hval] at h + · rw [ite_eq_right hval] at h simp at h - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-! ## ALPN protocol names -/ @@ -742,14 +742,14 @@ theorem parseAlpnGo_print : = some (n :: ns) have hform : (n.length.toUInt8 :: n) ++ printAlpnNames ns = n.length.toUInt8 :: (n ++ printAlpnNames ns) := by - simp only [List.cons_append, List.nil_append] + simp only [List.cons_append] rw [hform, parseAlpnGo_step, hlen, - if_neg (by + ite_eq_right (by intro hcon cases n with | nil => exact hhead.1 rfl | cons b bs => simp at hcon), - List.take_left, List.drop_left, if_pos rfl, ih f htail hf'] + List.take_left, List.drop_left, ite_eq_left rfl, ih f htail hf'] rfl /-- Printed ALPN names read back, at the top level. -/ @@ -786,11 +786,11 @@ theorem parseAlpnGo_inv : | cons len rest => rw [parseAlpnGo_step] at h by_cases h0 : len.toNat = 0 - · rw [if_pos h0] at h + · rw [ite_eq_left h0] at h simp at h - · rw [if_neg h0] at h + · rw [ite_eq_right h0] at h by_cases hc : (rest.take len.toNat).length = len.toNat - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨ns', hrec, hns⟩ := Option.map_eq_some_iff.mp h obtain ⟨hprint, hprops⟩ := ih _ _ hrec refine ⟨?_, ?_⟩ @@ -817,7 +817,7 @@ theorem parseAlpnGo_inv : simp at hc omega · exact hprops x hx - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-- ALPN names a successful read gives print back, at the @@ -839,16 +839,16 @@ theorem parseALPN_print {ns : List (List UInt8)} printAlpnNames ns) = some (Extension.alpn ns) unfold parseALPN rw [getU16_be16 _ (by omega)] - simp only [Option.bind_some] + simp only [] show (if (printAlpnNames ns).length = (printAlpnNames ns).length then parseAlpnNames (printAlpnNames ns) >>= fun ns' => if ns'.isEmpty then none else some (Extension.alpn ns') else none) = some (Extension.alpn ns) - rw [if_pos rfl, parseAlpnNames_print hw] + rw [ite_eq_left rfl, parseAlpnNames_print hw] show (if ns.isEmpty then none else some (Extension.alpn ns)) = some (Extension.alpn ns) - rw [if_neg (by + rw [ite_eq_right (by cases ns with | nil => exact absurd rfl hne | cons n ns' => simp)] @@ -868,10 +868,10 @@ theorem parseALPN_inv {v : List UInt8} {e : Extension} else none) = some e at h obtain ⟨hrest, hnlt⟩ := getU16_inv hn by_cases hc : rest.length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨ns, hrec, h⟩ := Option.bind_eq_some_iff.mp h by_cases hemp : ns.isEmpty = false - · rw [if_neg (by + · rw [ite_eq_right (by intro hcon rw [hcon] at hemp simp at hemp)] at h @@ -896,9 +896,9 @@ theorem parseALPN_inv {v : List UInt8} {e : Extension} cases h' : ns.isEmpty with | true => rfl | false => exact absurd h' hemp - rw [if_pos hemp2] at h + rw [ite_eq_left hemp2] at h simp at h - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-! ## The supported_versions value -/ @@ -933,7 +933,7 @@ theorem parseSV_print {vs : List Nat} parsePairs (printPairs vs) >>= fun vs' => some (Extension.supportedVersions vs') else none) = some (Extension.supportedVersions vs) - rw [if_pos hcond, parsePairs_printPairs hw] + rw [ite_eq_left hcond, parsePairs_printPairs hw] rfl /-- A supported_versions value a successful read gives is @@ -956,7 +956,7 @@ theorem parseSV_inv {v : List UInt8} {e : Extension} rw [hstep] at h by_cases hc : rest.length = n.toNat ∧ n.toNat % 2 = 0 ∧ 2 ≤ n.toNat - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨vs, hrec, h⟩ := Option.bind_eq_some_iff.mp h simp only [Option.some.injEq] at h subst h @@ -983,12 +983,12 @@ theorem parseSV_inv {v : List UInt8} {e : Extension} simp only [printPairs] at h5 have hz : rest.length = 0 := by rw [← h5] - simp [printPairs] + simp have h1 := hc.1 have h3 := hc.2.2 omega | cons v' vs' => intro hcon; cases hcon - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-! ## Key share entries -/ @@ -1078,7 +1078,7 @@ theorem parseSharesGo_print : show some (u16 (g / 256).toUInt8 g.toUInt8, _) = _ rw [u16_be16 g hhead.1] rw [hg] - simp only [Option.bind_some] + simp only [] show (getU16 ((k.length / 256).toUInt8 :: k.length.toUInt8 :: (k ++ printShares ss)) >>= fun (n, r2) => @@ -1095,7 +1095,7 @@ theorem parseSharesGo_print : k.length.toUInt8, _) = _ rw [u16_be16 _ (by omega)] rw [hk] - simp only [Option.bind_some] + simp only [] show (if k.length = 0 then none else if ((k ++ printShares ss).take k.length).length = k.length then @@ -1105,16 +1105,16 @@ theorem parseSharesGo_print : else some ((g, (k ++ printShares ss).take k.length) :: ss') else none) = some ((g, k) :: ss) - rw [if_neg (by + rw [ite_eq_right (by intro hcon cases k with | nil => exact hhead.2.1 rfl | cons b bs => simp at hcon), - List.take_left, List.drop_left, if_pos rfl, + List.take_left, List.drop_left, ite_eq_left rfl, ih f htail hnodup' hf'] show (if g ∈ ss.map Prod.fst then none else some ((g, k) :: ss)) = some ((g, k) :: ss) - rw [if_neg hnotin] + rw [ite_eq_right hnotin] /-- Printed key share entries read back, at the top level. -/ @@ -1177,18 +1177,18 @@ theorem parseSharesGo_inv : obtain ⟨hbs, hglt⟩ := getU16_inv hg obtain ⟨hr1, hnlt⟩ := getU16_inv hn by_cases h0 : n = 0 - · rw [if_pos h0] at h + · rw [ite_eq_left h0] at h simp at h - · rw [if_neg h0] at h + · rw [ite_eq_right h0] at h by_cases hc : (r2.take n).length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨ss', hrec, h⟩ := Option.bind_eq_some_iff.mp h obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec by_cases hd : g ∈ ss'.map Prod.fst - · rw [if_pos hd] at h + · rw [ite_eq_left hd] at h simp at h - · rw [if_neg hd] at h - simp only [Option.some.injEq, Prod.mk.injEq] at h + · rw [ite_eq_right hd] at h + simp only [Option.some.injEq] at h obtain ⟨rfl, rfl⟩ := h refine ⟨?_, ?_, ?_⟩ · have htake : (r2.take n).length = n := hc @@ -1213,7 +1213,7 @@ theorem parseSharesGo_inv : = g :: ss'.map Prod.fst := rfl rw [h2] exact List.nodup_cons.mpr ⟨hd, hnodup⟩ - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-- Key share entries a successful read gives print back, @@ -1240,13 +1240,13 @@ theorem parseKS_print {ss : List (Nat × List UInt8)} printShares ss) = some (Extension.keyShare ss) unfold parseKS rw [getU16_be16 _ (by omega)] - simp only [Option.bind_some] + simp only [] show (if (printShares ss).length = (printShares ss).length then parseShares (printShares ss) >>= fun ss' => some (Extension.keyShare ss') else none) = some (Extension.keyShare ss) - rw [if_pos rfl, parseShares_print hw hnodup] + rw [ite_eq_left rfl, parseShares_print hw hnodup] rfl /-- A key_share value a successful read gives is the @@ -1264,7 +1264,7 @@ theorem parseKS_inv {v : List UInt8} {e : Extension} else none) = some e at h obtain ⟨hrest, hnlt⟩ := getU16_inv hn by_cases hc : rest.length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨ss, hrec, h⟩ := Option.bind_eq_some_iff.mp h simp only [Option.some.injEq] at h subst h @@ -1279,7 +1279,7 @@ theorem parseKS_inv {v : List UInt8} {e : Extension} have hvlen : v.length = rest.length + 2 := by rw [hrest]; simp [be16] omega⟩ - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-! ## Extension values, dispatched by type -/ @@ -1354,7 +1354,7 @@ theorem parseExtValue_printExtValue (e : Extension) show parseExtValue 0 (printExtValue (Extension.serverName es)) = some (Extension.serverName es) unfold parseExtValue - rw [if_pos rfl] + rw [ite_eq_left rfl] exact parseSNI_print h'.1 h'.2.1 h'.2.2.1 h'.2.2.2 · have h' : ns ≠ [] ∧ (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ @@ -1362,7 +1362,7 @@ theorem parseExtValue_printExtValue (e : Extension) show parseExtValue 16 (printExtValue (Extension.alpn ns)) = some (Extension.alpn ns) unfold parseExtValue - rw [if_neg (by decide), if_pos rfl] + rw [ite_eq_right (by decide), ite_eq_left rfl] exact parseALPN_print h'.1 h'.2.1 h'.2.2 · have h' : vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ vs.length ≤ 127 := h @@ -1370,7 +1370,7 @@ theorem parseExtValue_printExtValue (e : Extension) (Extension.supportedVersions vs)) = some (Extension.supportedVersions vs) unfold parseExtValue - rw [if_neg (by decide), if_neg (by decide), if_pos rfl] + rw [ite_eq_right (by decide), ite_eq_right (by decide), ite_eq_left rfl] exact parseSV_print h'.1 h'.2.1 h'.2.2 · have h' : (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ s.2.length ≤ 65535) ∧ @@ -1379,8 +1379,8 @@ theorem parseExtValue_printExtValue (e : Extension) show parseExtValue 51 (printExtValue (Extension.keyShare ss)) = some (Extension.keyShare ss) unfold parseExtValue - rw [if_neg (by decide), if_neg (by decide), - if_neg (by decide), if_pos rfl] + rw [ite_eq_right (by decide), ite_eq_right (by decide), + ite_eq_right (by decide), ite_eq_left rfl] exact parseKS_print h'.1 h'.2.1 h'.2.2 · have h' : ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ t < 65536 ∧ v.length ≤ 65535 := h @@ -1390,8 +1390,8 @@ theorem parseExtValue_printExtValue (e : Extension) show parseExtValue t (printExtValue (Extension.opaque t v)) = some (Extension.opaque t v) unfold parseExtValue - rw [if_neg hn.1, if_neg hn2.1, if_neg hn3.1, - if_neg hn3.2] + rw [ite_eq_right hn.1, ite_eq_right hn2.1, ite_eq_right hn3.1, + ite_eq_right hn3.2] rfl /-- An extension value a successful read gives is the @@ -1405,37 +1405,37 @@ theorem parseExtValue_inv {t : Nat} {v : List UInt8} extType e = t ∧ printExtValue e = v ∧ ExtWF e := by unfold parseExtValue at h by_cases h0 : t = 0 - · rw [if_pos h0] at h + · rw [ite_eq_left h0] at h obtain ⟨es, he, hprint, hwf⟩ := parseSNI_inv hv h refine ⟨?_, ?_, ?_⟩ · rw [he]; exact h0.symm · rw [he]; exact hprint · rw [he]; exact hwf - · rw [if_neg h0] at h + · rw [ite_eq_right h0] at h by_cases h16 : t = 16 - · rw [if_pos h16] at h + · rw [ite_eq_left h16] at h obtain ⟨ns, he, hprint, hwf⟩ := parseALPN_inv hv h refine ⟨?_, ?_, ?_⟩ · rw [he]; exact h16.symm · rw [he]; exact hprint · rw [he]; exact hwf - · rw [if_neg h16] at h + · rw [ite_eq_right h16] at h by_cases h43 : t = 43 - · rw [if_pos h43] at h + · rw [ite_eq_left h43] at h obtain ⟨vs, he, hprint, hwf⟩ := parseSV_inv h refine ⟨?_, ?_, ?_⟩ · rw [he]; exact h43.symm · rw [he]; exact hprint · rw [he]; exact hwf - · rw [if_neg h43] at h + · rw [ite_eq_right h43] at h by_cases h51 : t = 51 - · rw [if_pos h51] at h + · rw [ite_eq_left h51] at h obtain ⟨ss, he, hprint, hwf⟩ := parseKS_inv hv h refine ⟨?_, ?_, ?_⟩ · rw [he]; exact h51.symm · rw [he]; exact hprint · rw [he]; exact hwf - · rw [if_neg h51] at h + · rw [ite_eq_right h51] at h simp only [Option.some.injEq] at h subst h refine ⟨rfl, rfl, ?_⟩ @@ -1521,7 +1521,7 @@ theorem parseExtsGo_print : ((printExtValue e).length / 256).toUInt8 :: (printExtValue e).length.toUInt8 :: (printExtValue e ++ printExts es) := by - simp only [be16, ← List.append_assoc, List.cons_append, + simp only [be16, List.cons_append, List.nil_append] rw [hform, parseExtsGo_step] have hg : getU16 ((extType e / 256).toUInt8 :: @@ -1537,7 +1537,7 @@ theorem parseExtsGo_print : (extType e).toUInt8, _) = _ rw [u16_be16 _ (extType_lt hwe)] rw [hg] - simp only [Option.bind_some] + simp only [] show (getU16 (((printExtValue e).length / 256).toUInt8 :: (printExtValue e).length.toUInt8 :: (printExtValue e ++ printExts es)) >>= @@ -1559,7 +1559,7 @@ theorem parseExtsGo_print : have h2 := printExtValue_length_le hwe omega)] rw [hk] - simp only [Option.bind_some] + simp only [] show (if ((printExtValue e ++ printExts es).take (printExtValue e).length).length = (printExtValue e).length then @@ -1571,7 +1571,7 @@ theorem parseExtsGo_print : if extType e' ∈ es'.map extType then none else some (e' :: es') else none) = some (e :: es) - rw [List.take_left, List.drop_left, if_pos rfl, + rw [List.take_left, List.drop_left, ite_eq_left rfl, parseExtValue_printExtValue e hwe] show (parseExtsGo f (printExts es) >>= fun es' => if extType e ∈ es'.map extType then none @@ -1579,7 +1579,7 @@ theorem parseExtsGo_print : rw [ih f htail hnodup' hf'] show (if extType e ∈ es.map extType then none else some (e :: es)) = some (e :: es) - rw [if_neg hnotin] + rw [ite_eq_right hnotin] /-- Printed extensions read back, at the top level. -/ theorem parseExts_print {es : List Extension} @@ -1640,16 +1640,16 @@ theorem parseExtsGo_inv : obtain ⟨hbs, htlt⟩ := getU16_inv ht obtain ⟨hr1, hnlt⟩ := getU16_inv hn by_cases hc : (r2.take n).length = n - · rw [if_pos hc] at h + · rw [ite_eq_left hc] at h obtain ⟨e, hev, h⟩ := Option.bind_eq_some_iff.mp h obtain ⟨es', hrec, h⟩ := Option.bind_eq_some_iff.mp h obtain ⟨hprint, hprops, hnodup⟩ := ih _ _ hrec obtain ⟨htype, hvalue, hwe⟩ := parseExtValue_inv htlt (by rw [hc]; omega) hev by_cases hd : extType e ∈ es'.map extType - · rw [if_pos hd] at h + · rw [ite_eq_left hd] at h simp at h - · rw [if_neg hd] at h + · rw [ite_eq_right hd] at h simp only [Option.some.injEq] at h subst h refine ⟨?_, ?_, ?_⟩ @@ -1673,7 +1673,7 @@ theorem parseExtsGo_inv : = extType e :: es'.map extType := rfl rw [h2] exact List.nodup_cons.mpr ⟨hd, hnodup⟩ - · rw [if_neg hc] at h + · rw [ite_eq_right hc] at h simp at h /-- Extensions a successful read gives print back, at the @@ -1731,13 +1731,13 @@ theorem parseBodyFields_print (m : Message) (hw : WF m) : rw [printBodyFields_eq] unfold parseBodyFields rw [withU16_be16 hver, withBytes_app hrand, withU8_cons, hsb, - if_pos hsess, withBytes_app rfl, withU16_be16 (by omega), - if_pos hguard, withBytes_app rfl, + ite_eq_left hsess, withBytes_app rfl, withU16_be16 (by omega), + ite_eq_left hguard, withBytes_app rfl, parsePairs_printPairs hsuites_lt, Option.bind_some, - withU8_cons, hcb, if_pos hcomp_len1, withBytes_app rfl, - if_pos hcomp0, withU16_be16 (by omega), withBytes_self, - if_pos rfl, parseExts_print hext_wf hnodup, Option.bind_some, - if_pos hpsk, if_pos h13] + withU8_cons, hcb, ite_eq_left hcomp_len1, withBytes_app rfl, + ite_eq_left hcomp0, withU16_be16 (by omega), withBytes_self, + ite_eq_left rfl, parseExts_print hext_wf hnodup, Option.bind_some, + ite_eq_left hpsk, ite_eq_left h13] /-- A parsed hello prints back to the input bytes, and every field satisfies the well formedness bounds. -/ @@ -1763,35 +1763,35 @@ theorem parseBodyFields_inv {bs : List UInt8} {h : Hello} obtain ⟨rand, r2, hrand, hr1, hp⟩ := withBytes_inv hp obtain ⟨slen, r3, hr2, _, hp⟩ := withU8_inv hp by_cases hs : slen ≤ 32 - case neg => rw [if_neg hs] at hp; cases hp - rw [if_pos hs] at hp + case neg => rw [ite_eq_right hs] at hp; cases hp + rw [ite_eq_left hs] at hp obtain ⟨sess, r4, hsesslen, hr3, hp⟩ := withBytes_inv hp obtain ⟨clen, r5, hr4, hclen_lt, hp⟩ := withU16_inv hp by_cases hg : clen % 2 = 0 ∧ 2 ≤ clen - case neg => rw [if_neg hg] at hp; cases hp - rw [if_pos hg] at hp + case neg => rw [ite_eq_right hg] at hp; cases hp + rw [ite_eq_left hg] at hp obtain ⟨cbytes, r6, hcbyteslen, hr5, hp⟩ := withBytes_inv hp obtain ⟨suites, s7, hp⟩ := Option.bind_eq_some_iff.mp hp obtain ⟨mlen, r7, hr6, hmlen_lt, hp⟩ := withU8_inv hp by_cases hm : 1 ≤ mlen - case neg => rw [if_neg hm] at hp; cases hp - rw [if_pos hm] at hp + case neg => rw [ite_eq_right hm] at hp; cases hp + rw [ite_eq_left hm] at hp obtain ⟨comps, r8, hcomplen, hr7, hp⟩ := withBytes_inv hp by_cases h0 : (0 : UInt8) ∈ comps - case neg => rw [if_neg h0] at hp; cases hp - rw [if_pos h0] at hp + case neg => rw [ite_eq_right h0] at hp; cases hp + rw [ite_eq_left h0] at hp obtain ⟨elen, r9, hr8, helen_lt, hp⟩ := withU16_inv hp obtain ⟨ebytes, r10, hebyteslen, hr9, hp⟩ := withBytes_inv hp by_cases hr : r10 = [] - case neg => rw [if_neg hr] at hp; cases hp - rw [if_pos hr] at hp + case neg => rw [ite_eq_right hr] at hp; cases hp + rw [ite_eq_left hr] at hp obtain ⟨exts, s12, hp⟩ := Option.bind_eq_some_iff.mp hp by_cases hpsk : 41 ∉ (exts.dropLast).map extType - case neg => rw [if_neg hpsk] at hp; cases hp - rw [if_pos hpsk] at hp + case neg => rw [ite_eq_right hpsk] at hp; cases hp + rw [ite_eq_left hpsk] at hp by_cases h13 : offersTls13 exts = true → comps = [0] - case neg => rw [if_neg h13] at hp; cases hp - rw [if_pos h13] at hp + case neg => rw [ite_eq_right h13] at hp; cases hp + rw [ite_eq_left h13] at hp simp only [Option.some.injEq] at hp subst hp have hpp : printPairs suites = cbytes := (parsePairs_inv s7).1 @@ -1858,8 +1858,8 @@ theorem parseBody_print (m : Message) (hw : WF m) : hflen⟩ := hw rw [printBody_eq] unfold parseBody - rw [withU8_cons, if_pos (by decide : ((1 : UInt8).toNat = 1)), - withU24_be24 (by omega), withBytes_self, if_pos rfl] + rw [withU8_cons, ite_eq_left (by decide : ((1 : UInt8).toNat = 1)), + withU24_be24 (by omega), withBytes_self, ite_eq_left rfl] exact parseBodyFields_print m hwf /-- A parsed handshake message prints back to the input @@ -1884,13 +1884,13 @@ theorem parseBody_inv {body : List UInt8} {h : Hello} unfold parseBody at hparse obtain ⟨htype, r1, hbody1, _, hp⟩ := withU8_inv hparse by_cases ht : htype = 1 - case neg => rw [if_neg ht] at hp; cases hp - rw [if_pos ht] at hp + case neg => rw [ite_eq_right ht] at hp; cases hp + rw [ite_eq_left ht] at hp obtain ⟨hlen, r2, hr1, _, hp⟩ := withU24_inv hp obtain ⟨fbs, r3, hfbs, hr2, hp⟩ := withBytes_inv hp by_cases hr : r3 = [] - case neg => rw [if_neg hr] at hp; cases hp - rw [if_pos hr] at hp + case neg => rw [ite_eq_right hr] at hp; cases hp + rw [ite_eq_left hr] at hp have hfi := parseBodyFields_inv hp have hbyte : htype.toUInt8 = (1 : UInt8) := by rw [ht] @@ -1921,9 +1921,9 @@ theorem parse_print (m : Message) (hw : WF m) : omega rw [print_eq] unfold parse - rw [withU8_cons, if_pos (by decide : ((22 : UInt8).toNat = 22)), - withU16_be16 hrv, withU16_be16 hblt, if_pos hble, - withBytes_self, if_pos rfl, parseBody_print m hwf, + rw [withU8_cons, ite_eq_left (by decide : ((22 : UInt8).toNat = 22)), + withU16_be16 hrv, withU16_be16 hblt, ite_eq_left hble, + withBytes_self, ite_eq_left rfl, parseBody_print m hwf, Option.map_some] /-- A parsed message prints back to the input bytes, and the @@ -1934,17 +1934,17 @@ theorem print_parse {bs : List UInt8} {m : Message} unfold parse at hparse obtain ⟨ct, r1, hbs1, _, hp⟩ := withU8_inv hparse by_cases hct : ct = 22 - case neg => rw [if_neg hct] at hp; cases hp - rw [if_pos hct] at hp + case neg => rw [ite_eq_right hct] at hp; cases hp + rw [ite_eq_left hct] at hp obtain ⟨rv, r2, hr1, hrv, hp⟩ := withU16_inv hp obtain ⟨rlen, r3, hr2, hrlen, hp⟩ := withU16_inv hp by_cases hrl : rlen ≤ 16384 - case neg => rw [if_neg hrl] at hp; cases hp - rw [if_pos hrl] at hp + case neg => rw [ite_eq_right hrl] at hp; cases hp + rw [ite_eq_left hrl] at hp obtain ⟨body, r4, hbodylen, hr3, hp⟩ := withBytes_inv hp by_cases hr : r4 = [] - case neg => rw [if_neg hr] at hp; cases hp - rw [if_pos hr] at hp + case neg => rw [ite_eq_right hr] at hp; cases hp + rw [ite_eq_left hr] at hp obtain ⟨hh, hpb, hp⟩ := Option.map_eq_some_iff.mp hp subst hp obtain ⟨hbody_eq, hver, hrand, hsess, hsne, hslt, hslen, hcne, diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index 0e8cf20..3afd0dd 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -101,9 +101,9 @@ theorem Spec.rejects_record_overflow (ct v1 v2 a b : UInt8) unfold parse rw [ClientHello.Proofs.withU8_cons] by_cases hct : ct.toNat = 22 - · rw [if_pos hct, ClientHello.Proofs.withU16_cons, - ClientHello.Proofs.withU16_cons, if_neg hover] - · rw [if_neg hct] + · rw [ite_eq_left hct, ClientHello.Proofs.withU16_cons, + ClientHello.Proofs.withU16_cons, ite_eq_right hover] + · rw [ite_eq_right hct] theorem Spec.rejects_trailing_bytes : From e385567e7d33ff71f1bd707f6d87e698079604a8 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 18:17:19 +0000 Subject: [PATCH 12/19] Reflow two paragraphs of the page README's well formedness paragraph had an overlong line and a doubled "and" after the compression rule was added, and one paragraph of SPEC's "Reading past the end" had an overlong line. Wording only, no change in meaning. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 27 ++++++++++++++------------- SPEC.md | 9 +++++---- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/README.md b/README.md index e43f8ed..fa600b6 100644 --- a/README.md +++ b/README.md @@ -104,19 +104,20 @@ legacy version each fit two bytes; the random holds exactly 32 bytes; the session id holds at most 32 bytes; the cipher suites are nonempty, each fits two bytes, and there are at most 32767 of them; the compression methods -are nonempty, contain the null method 0, and number at -most 255, and are exactly [0] when the hello offers TLS 1.3 -(its supported_versions lists 0x0304); every extension is well formed (its lengths fit -their fields, SNI has distinct entry types and a nonempty -host name when present, ALPN names are nonempty, key -share groups are distinct with nonempty keys, and an -opaque extension's type is none of the four decoded -types); no extension type stands twice; no extension but -the last has type 41 (pre_shared_key); the printed -extensions block fits two bytes of length; and the -printed handshake message, its four header bytes and the -body fields, is at most 2^14 = 16384 bytes, the record -limit of RFC 8446 section 5.1. +are nonempty, contain the null method 0, number at most +255, and are exactly [0] when the hello offers TLS 1.3 +(its supported_versions lists 0x0304); every extension is +well formed (its lengths fit their fields, SNI has +distinct entry types and a nonempty host name when +present, ALPN names are nonempty, key share groups are +distinct with nonempty keys, and an opaque extension's +type is none of the four decoded types); no extension +type stands twice; no extension but the last has type 41 +(pre_shared_key); the printed extensions block fits two +bytes of length; and the printed handshake message, its +four header bytes and the body fields, is at most +2^14 = 16384 bytes, the record limit of RFC 8446 section +5.1. The two round trip theorems rest on the proofs in `Proofs/RoundTrip.lean`, where they are diff --git a/SPEC.md b/SPEC.md index 3bc8d1b..af282fe 100644 --- a/SPEC.md +++ b/SPEC.md @@ -239,10 +239,11 @@ rule out: a field read from input too short for it gives over a value already cut to its declared length. What the theorems do say about the bytes is `Spec.print_parse`: every byte of an accepted input is accounted for, since -the parsed message prints back to exactly that input. Lengths -that run past the input are refused in the cases of -`Spec.rejects_record_length_longer` and -`Spec.rejects_extension_overrun`, and the tests cover more. +the parsed message prints back to exactly that input. +Lengths that run past the input are refused in the cases +of `Spec.rejects_record_length_longer` and +`Spec.rejects_extension_overrun`, and the tests cover +more. ## Slice boundaries From 05d78d5b321706e2b72d4080f7bc9c51d58272be Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 22:09:17 +0000 Subject: [PATCH 13/19] State the TLS 1.3 compression rule on the extension, not on offersTls13 The independent check of the carried branch found that Spec.tls13_compression_null took its meaning from offersTls13, a definition in the code under proof. A wrong program could change offersTls13 to look only at the first listed version and still meet every statement, with Spec.lean and the approval hash unchanged; such a program accepts supported_versions [0x0303, 0x0304] with compression methods [1, 0]. The statement now names the extension and the version itself: for an accepted hello, a supported_versions extension in its list whose versions hold 772 (0x0304) means the compression methods are [0]. It is proved from print_parse and a new lemma, offersTls13_of_mem. Under that mutant the statement is false. Spec.rejects_tls13_compression_second adds the refusal with 0x0304 listed second ([0x0303, 0x0304] with [1, 0]), and the tests gain the same named case. README and SPEC tables, comparator.json, the bar.toml comment on offersTls13 (the parser calls it; no statement reads it) and the test record (4,939 inputs, 0 failures) follow. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/RoundTrip.lean | 13 +++++++++++++ Proofs/SpecProofs.lean | 11 +++++++++-- README.md | 3 ++- SPEC.md | 3 ++- Spec.lean | 19 +++++++++++++++---- bar.toml | 4 +++- comparator.json | 1 + tests/TEST-RESULTS.md | 7 ++++--- tests/run_tests.py | 5 +++++ 9 files changed, 54 insertions(+), 12 deletions(-) diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index 5f03697..c803463 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -1702,6 +1702,19 @@ theorem printBodyFields_eq (h : Hello) : printExts h.extensions)))))))) := by simp only [printBodyFields, List.append_assoc, List.cons_append] +/-- A list holding a supported_versions extension whose list holds + 0x0304 offers TLS 1.3, wherever the extension and the version + stand. -/ +theorem offersTls13_of_mem {exts : List Extension} {vs : List Nat} + (h : Extension.supportedVersions vs ∈ exts) (h13 : 772 ∈ vs) : + offersTls13 exts = true := by + induction exts with + | nil => simp at h + | cons e es ih => + rcases List.mem_cons.mp h with rfl | h' + · simp [offersTls13, h13] + · cases e <;> simp [offersTls13, ih h'] + /-- The printed body fields read back as the hello. -/ theorem parseBodyFields_print (m : Message) (hw : WF m) : parseBodyFields (printBodyFields m.hello) = some m.hello := by diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index 3afd0dd..8f4a585 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -23,12 +23,14 @@ theorem Spec.print_parse {bs : List UInt8} {m : Message} theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} + {vs : List Nat} (hparse : parse bs = some m) - (h13 : offersTls13 m.hello.extensions = true) : + (hsv : Extension.supportedVersions vs ∈ m.hello.extensions) + (h13 : 772 ∈ vs) : m.hello.compressionMethods = [0] := by obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hc13, _, _⟩ := (ClientHello.Proofs.print_parse hparse).2 - exact hc13 h13 + exact hc13 (ClientHello.Proofs.offersTls13_of_mem hsv h13) theorem Spec.psk_last {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : @@ -156,6 +158,11 @@ theorem Spec.rejects_tls13_compression : decide +kernel +theorem Spec.rejects_tls13_compression_second : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 3, 3, 4] : List UInt8)).isSome = false := by + decide +kernel + + theorem Spec.rejects_duplicate_extension : (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index fa600b6..3a9a23f 100644 --- a/README.md +++ b/README.md @@ -49,7 +49,7 @@ Statements about every input: | Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | | A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | -| Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | +| Every accepted hello with a supported_versions extension that lists 0x0304, in any position (a hello that offers TLS 1.3), has exactly the compression methods [0]. | `Spec.tls13_compression_null` | | In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | Together, the two round trips say that the parser accepts @@ -88,6 +88,7 @@ do not state the rule for every input. | The hello of `Spec.accepts_empty_extensions` with compression methods [1], without the null method, is refused. | `Spec.rejects_compression_without_null` | | The hello of `Spec.accepts_empty_extensions` with an empty compression method list is refused. (An empty list holds no null method, so the rule above refuses it too.) | `Spec.rejects_empty_compression` | | The hello of `Spec.accepts_supported_versions`, which offers TLS 1.3, with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | +| The input of `Spec.rejects_tls13_compression` with its supported_versions list in the other order, [0x0303, 0x0304], is refused. | `Spec.rejects_tls13_compression_second` | | A hello with two supported_versions extensions is refused. | `Spec.rejects_duplicate_extension` | | The hello of `Spec.accepts_psk_last` with its two extensions in the other order, pre_shared_key first, is refused. | `Spec.rejects_psk_not_last` | | A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | diff --git a/SPEC.md b/SPEC.md index af282fe..8ae9907 100644 --- a/SPEC.md +++ b/SPEC.md @@ -187,7 +187,7 @@ Statements about every input: | Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | | A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | -| Every accepted hello that offers TLS 1.3 (its supported_versions lists 0x0304) has exactly the compression methods [0]. | `Spec.tls13_compression_null` | +| Every accepted hello with a supported_versions extension that lists 0x0304, in any position (a hello that offers TLS 1.3), has exactly the compression methods [0]. | `Spec.tls13_compression_null` | | In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | Single inputs, each about the one input written out in @@ -217,6 +217,7 @@ it: | The hello of `Spec.accepts_empty_extensions` with compression methods [1], without the null method, is refused. | `Spec.rejects_compression_without_null` | | The hello of `Spec.accepts_empty_extensions` with an empty compression method list is refused. (An empty list holds no null method, so the rule above refuses it too.) | `Spec.rejects_empty_compression` | | The hello of `Spec.accepts_supported_versions`, which offers TLS 1.3, with compression methods [1, 0] is refused. | `Spec.rejects_tls13_compression` | +| The input of `Spec.rejects_tls13_compression` with its supported_versions list in the other order, [0x0303, 0x0304], is refused. | `Spec.rejects_tls13_compression_second` | | A hello with two supported_versions extensions is refused. | `Spec.rejects_duplicate_extension` | | The hello of `Spec.accepts_psk_last` with its two extensions in the other order, pre_shared_key first, is refused. | `Spec.rejects_psk_not_last` | | A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | diff --git a/Spec.lean b/Spec.lean index 4b45009..bf4a87a 100644 --- a/Spec.lean +++ b/Spec.lean @@ -41,12 +41,17 @@ Each of these follows from `Spec.print_parse`, since the well formedness predicate includes the rule; it is stated on its own so that the claim on the page names a theorem that says exactly that. -/ -/-- An accepted hello that offers TLS 1.3, that is whose supported_versions - lists 0x0304, carries exactly one compression method, the null method - 0 (RFC 8446 section 4.1.2). -/ +/-- An accepted hello that offers TLS 1.3, that is one with a + supported_versions extension whose list holds 0x0304 (772) in any + position, carries exactly one compression method, the null method 0 + (RFC 8446 section 4.1.2). The hypotheses name the extension and the + version themselves, so what "offers TLS 1.3" means is fixed here and + not by a definition in the code. -/ theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} + {vs : List Nat} (hparse : parse bs = some m) - (h13 : offersTls13 m.hello.extensions = true) : + (hsv : Extension.supportedVersions vs ∈ m.hello.extensions) + (h13 : 772 ∈ vs) : m.hello.compressionMethods = [0] := sorry /-- In an accepted hello, no extension but the last has type 41 @@ -184,6 +189,12 @@ theorem Spec.rejects_empty_compression : theorem Spec.rejects_tls13_compression : (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 4, 3, 3] : List UInt8)).isSome = false := sorry +/-- The hello of `Spec.rejects_tls13_compression` with its supported_versions + list in the other order, [0x0303, 0x0304], is refused too: a hello + offers TLS 1.3 when 0x0304 is anywhere in the list, not only first. -/ +theorem Spec.rejects_tls13_compression_second : + (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 2, 1, 0, 0, 9, 0, 43, 0, 5, 4, 3, 3, 3, 4] : List UInt8)).isSome = false := sorry + /-- An extension type standing twice in one block is refused. -/ theorem Spec.rejects_duplicate_extension : (parse ([22, 3, 1, 0, 61, 1, 0, 0, 57, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 14, 0, 43, 0, 3, 2, 3, 4, 0, 43, 0, 3, 2, 3, 3] : List UInt8)).isSome = false := sorry diff --git a/bar.toml b/bar.toml index 4c44f5d..3260b5d 100644 --- a/bar.toml +++ b/bar.toml @@ -29,7 +29,9 @@ code = [ "ClientHello.printAlpnNames", "ClientHello.printShares", "ClientHello.printExtValue", "ClientHello.printExt", "ClientHello.printExts", "ClientHello.printBodyFields", "ClientHello.printBody", "ClientHello.print", - # Well formedness, and whether a hello offers TLS 1.3. + # Well formedness, and the parser's test of whether a hello offers + # TLS 1.3. offersTls13 is listed because parseBodyFields calls it; no + # statement reads it. "ClientHello.ExtWF", "ClientHello.WF", "ClientHello.offersTls13", # The length checked readers and the parser. "ClientHello.getU16", "ClientHello.withU8", "ClientHello.withU16", diff --git a/comparator.json b/comparator.json index 3e476fc..90aa33d 100644 --- a/comparator.json +++ b/comparator.json @@ -27,6 +27,7 @@ "Spec.rejects_compression_without_null", "Spec.rejects_empty_compression", "Spec.rejects_tls13_compression", + "Spec.rejects_tls13_compression_second", "Spec.rejects_duplicate_extension", "Spec.rejects_psk_not_last", "Spec.rejects_extension_overrun", diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index 1f8c70e..fab384f 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -2,7 +2,7 @@ - Oracle: the harness oracle in tests/run_tests.py, a second reading of SPEC.md in Python 3.13.17, for every input; and OpenSSL 3.0.13 30 Jan 2024 through Python's ssl module, which built 24 of the inputs as real ClientHellos that must be accepted and printed back byte for byte - Seed: 20261026 -- Inputs: 4938 +- Inputs: 4939 - Failures: 0 - Command: python3 tests/run_tests.py --seed 20261026 --count 3200 @@ -16,14 +16,14 @@ Python's ssl module builds real ClientHellos in memory: a client SSLObject over | part | run | agreed | | --- | --- | --- | -| named cases | 39 | 39 | +| named cases | 40 | 40 | | generated messages | 3200 | 3200 | | mutations of the full hello | 1308 | 1308 | | random raw byte strings | 300 | 300 | | hellos near the 2^14 record limit | 60 | 60 | | ClientHellos built by OpenSSL | 24 | 24 | | malformed request lines | 7 | 7 | -| total | 4938 | 4938 | +| total | 4939 | 4939 | Of the 3200 generated messages, the oracle accepts 1266 and rejects 1934. @@ -44,6 +44,7 @@ Of the 3200 generated messages, the oracle accepts 1266 and rejects 1934. - compression methods without 0: reject (53 bytes) - TLS 1.3 hello with compression methods 01 00: reject (60 bytes) - TLS 1.3 hello with compression methods 00 00: reject (62 bytes) +- TLS 1.3 hello listing 0x0304 second, supported_versions [0x0303, 0x0304], with compression methods 01 00: reject (62 bytes) - TLS 1.2 hello (supported_versions 0x0303 only) with compression methods 01 00, accepted: accept (60 bytes) - hello without extensions, compression methods 01 00, accepted: accept (53 bytes) - pre_shared_key last, after key_share, accepted: accept (157 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index 8282ef0..9b7afb2 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -486,6 +486,11 @@ def named_cases(): build_hello(comps=(0, 0), exts=[(43, sv_value([0x0304, 0x0303]))]), False)) + cases.append(("TLS 1.3 hello listing 0x0304 second, supported_versions " + "[0x0303, 0x0304], with compression methods 01 00", + build_hello(comps=(1, 0), + exts=[(43, sv_value([0x0303, 0x0304]))]), + False)) cases.append(("TLS 1.2 hello (supported_versions 0x0303 only) " "with compression methods 01 00, accepted", build_hello(comps=(1, 0), From 391ce28a30b617fc1a492a031c8f8598aa6f43a3 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 22:15:26 +0000 Subject: [PATCH 14/19] Move the well formedness predicate into a spec file, Spec/Defs.lean The independent check of the carried branch found that WF and ExtWF, which give Spec.parse_print and Spec.print_parse their meaning, were listed as code under proof, though the parser never calls them. Bar checklist item 4 says a definition that only gives a statement its meaning belongs in the spec files. As it was, a wrong program could tighten the parser and WF together (record length at most 16383, body fields at most 16379) and still meet every statement with Spec.lean and the approval hash unchanged, refusing a legal record of exactly 2^14 bytes. ExtWF and WF now live in Spec/Defs.lean as Spec.ExtWF and Spec.WF, with the same conjuncts. bar.toml lists Spec/Defs.lean among the spec files, so the approval hash pins the predicate, and drops WF and ExtWF from the code list. The TLS 1.3 conjunct is written on the extension itself (a supported_versions extension whose list holds 772 means compression methods [0]), so the spec files read nothing of the parser; offersTls13 stays in the code for the parser alone. The checker's walk now descends into Spec.WF, so the code list also names the field projections it reads and Extension.casesOn, the case split Spec.ExtWF's match compiles to. The proofs open Spec (WF ExtWF) and bridge the parser's offersTls13 test to the new conjunct with offersTls13_of_mem and a new converse, mem_of_offersTls13. Spec.lean's header, README and SPEC.md say where the predicate is and that the approval covers it. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- ClientHello/Value.lean | 61 +++---------------------------- Proofs/RoundTrip.lean | 32 +++++++++++++++-- Proofs/SpecProofs.lean | 7 ++-- README.md | 73 ++++++++++++++++++++----------------- SPEC.md | 10 ++++-- Spec.lean | 16 +++++---- Spec/Defs.lean | 82 ++++++++++++++++++++++++++++++++++++++++++ bar.toml | 25 +++++++------ 8 files changed, 191 insertions(+), 115 deletions(-) create mode 100644 Spec/Defs.lean diff --git a/ClientHello/Value.lean b/ClientHello/Value.lean index ccccd20..28a26db 100644 --- a/ClientHello/Value.lean +++ b/ClientHello/Value.lean @@ -176,66 +176,13 @@ def print (m : Message) : List UInt8 := /-- Whether an extension list offers TLS 1.3: it holds a supported_versions extension that lists 0x0304 (772). Such a hello is a TLS 1.3 ClientHello in the sense of RFC 8446 - section 4.1.2, whatever older versions it also lists. -/ + section 4.1.2, whatever older versions it also lists. The + parser uses this test. The specification does not: it + states the same condition on the extension itself, in + `Spec.WF` and `Spec.tls13_compression_null`. -/ def offersTls13 : List Extension → Bool | [] => false | .supportedVersions vs :: es => vs.contains 772 || offersTls13 es | _ :: es => offersTls13 es -/-- Well formedness of one extension, at the level the - printer needs: every length it writes fits the field that - holds it, and the checks the parser makes on the value - hold. -/ -def ExtWF : Extension → Prop - | .serverName es => - es ≠ [] ∧ - (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ - (e.1 = 0 → e.2 ≠ [])) ∧ - List.Nodup (es.map Prod.fst) ∧ - (printNameEntries es).length ≤ 65533 - | .alpn ns => - ns ≠ [] ∧ - (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ - (printAlpnNames ns).length ≤ 65533 - | .supportedVersions vs => - vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ vs.length ≤ 127 - | .keyShare ss => - (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ - s.2.length ≤ 65535) ∧ - List.Nodup (ss.map Prod.fst) ∧ - (printShares ss).length ≤ 65533 - | .opaque t v => - ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ - t < 65536 ∧ v.length ≤ 65535 - -/-- A well formed message: every number fits the field that - holds it, every byte block holds the length its field - demands, the cipher suites and compression methods meet - their rules, every extension is well formed, no - extension type stands twice, pre_shared_key (type 41) - stands last if present (RFC 8446 section 4.2.11), a - hello that offers TLS 1.3 carries exactly the null - compression method (RFC 8446 section 4.1.2), and the - handshake message - (four header bytes and the body fields) fits a record of - at most 2^14 = 16384 bytes (RFC 8446 section 5.1). -/ -def WF (m : Message) : Prop := - m.recordVersion < 65536 ∧ - m.hello.legacyVersion < 65536 ∧ - m.hello.random.length = 32 ∧ - m.hello.sessionId.length ≤ 32 ∧ - m.hello.cipherSuites ≠ [] ∧ - (∀ v ∈ m.hello.cipherSuites, v < 65536) ∧ - m.hello.cipherSuites.length ≤ 32767 ∧ - m.hello.compressionMethods ≠ [] ∧ - (0 : UInt8) ∈ m.hello.compressionMethods ∧ - m.hello.compressionMethods.length ≤ 255 ∧ - (∀ e ∈ m.hello.extensions, ExtWF e) ∧ - List.Nodup (m.hello.extensions.map extType) ∧ - 41 ∉ (m.hello.extensions.dropLast).map extType ∧ - (offersTls13 m.hello.extensions = true → - m.hello.compressionMethods = [0]) ∧ - (printExts m.hello.extensions).length ≤ 65535 ∧ - (printBodyFields m.hello).length ≤ 16380 - end ClientHello diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean index c803463..fde11e2 100644 --- a/Proofs/RoundTrip.lean +++ b/Proofs/RoundTrip.lean @@ -22,10 +22,14 @@ -/ import ClientHello +import Spec.Defs namespace ClientHello.Proofs open ClientHello +-- `WF` and `ExtWF` below are `Spec.WF` and `Spec.ExtWF`, the +-- well formedness predicate of the specification (`Spec/Defs.lean`). +open Spec (WF ExtWF) /-! ## Byte and number basics -/ @@ -1715,12 +1719,35 @@ theorem offersTls13_of_mem {exts : List Extension} {vs : List Nat} · simp [offersTls13, h13] · cases e <;> simp [offersTls13, ih h'] +/-- A list that offers TLS 1.3 holds a supported_versions + extension whose list holds 0x0304. -/ +theorem mem_of_offersTls13 {exts : List Extension} + (h : offersTls13 exts = true) : + ∃ vs, Extension.supportedVersions vs ∈ exts ∧ 772 ∈ vs := by + induction exts with + | nil => simp [offersTls13] at h + | cons e es ih => + cases e with + | supportedVersions vs => + simp only [offersTls13, Bool.or_eq_true] at h + rcases h with h | h + · exact ⟨vs, List.mem_cons_self, by simpa using h⟩ + · obtain ⟨ws, hm, h7⟩ := ih h + exact ⟨ws, List.mem_cons_of_mem _ hm, h7⟩ + | _ => + obtain ⟨ws, hm, h7⟩ := ih (by simpa [offersTls13] using h) + exact ⟨ws, List.mem_cons_of_mem _ hm, h7⟩ + /-- The printed body fields read back as the hello. -/ theorem parseBodyFields_print (m : Message) (hw : WF m) : parseBodyFields (printBodyFields m.hello) = some m.hello := by obtain ⟨_, hver, hrand, hsess, hsuites_ne, hsuites_lt, hsuites_len, hcomp_ne, hcomp0, hcomp_len, hext_wf, - hnodup, hpsk, h13, hext_len, _⟩ := hw + hnodup, hpsk, h13sv, hext_len, _⟩ := hw + have h13 : offersTls13 m.hello.extensions = true → + m.hello.compressionMethods = [0] := fun ho => + let ⟨vs, hm, h7⟩ := mem_of_offersTls13 ho + h13sv vs hm h7 have hsuites_len1 : 1 ≤ m.hello.cipherSuites.length := by cases hcs : m.hello.cipherSuites with | nil => exact absurd hcs hsuites_ne @@ -1976,4 +2003,5 @@ theorem print_parse {bs : List UInt8} {m : Message} rw [hbody_eq, hbodylen, hbs1, hctb, hr1, hr2, hr3, hr, List.append_nil] exact ⟨hprint, hrv, hver, hrand, hsess, hsne, hslt, hslen, - hcne, hc0, hclen, hewf, hnod, hpsk, h13, helen, hflen⟩ + hcne, hc0, hclen, hewf, hnod, hpsk, + fun vs hm h7 => h13 (offersTls13_of_mem hm h7), helen, hflen⟩ diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index 8f4a585..e037beb 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -8,17 +8,18 @@ -/ import ClientHello +import Spec.Defs import Proofs.RoundTrip open ClientHello -theorem Spec.parse_print (m : Message) (hw : WF m) : +theorem Spec.parse_print (m : Message) (hw : Spec.WF m) : parse (print m) = some m := ClientHello.Proofs.parse_print m hw theorem Spec.print_parse {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : - print m = bs ∧ WF m := + print m = bs ∧ Spec.WF m := ClientHello.Proofs.print_parse hparse @@ -30,7 +31,7 @@ theorem Spec.tls13_compression_null {bs : List UInt8} {m : Message} m.hello.compressionMethods = [0] := by obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, hc13, _, _⟩ := (ClientHello.Proofs.print_parse hparse).2 - exact hc13 (ClientHello.Proofs.offersTls13_of_mem hsv h13) + exact hc13 vs hsv h13 theorem Spec.psk_last {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : diff --git a/README.md b/README.md index 3a9a23f..c986916 100644 --- a/README.md +++ b/README.md @@ -9,14 +9,16 @@ from RFC 6066, and ALPN from RFC 7301. The definitions are in `ClientHello/Value.lean` (the data model and the printer) and `ClientHello/Parse.lean` (the parser). The proofs are in `Proofs/RoundTrip.lean`. The rules are -written out in `SPEC.md`. This slice reads one TLS record -holding one ClientHello; it does no handshake crypto and -parses no certificates. +written out in `SPEC.md`, and as one Lean predicate, +`Spec.WF`, in `Spec/Defs.lean`. This slice reads one TLS +record holding one ClientHello; it does no handshake +crypto and parses no certificates. The statements a reviewer approves are in `Spec.lean`, -with their proofs in `Proofs/SpecProofs.lean`. No reviewer -has approved them yet, so this project is not called -verified. +with the definition of a well formed message they use in +`Spec/Defs.lean`, and their proofs in +`Proofs/SpecProofs.lean`. No reviewer has approved them +yet, so this project is not called verified. ## How to run it @@ -100,25 +102,30 @@ do not state the rule for every input. | A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | | A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | -A message is well formed when the record version and the -legacy version each fit two bytes; the random holds -exactly 32 bytes; the session id holds at most 32 bytes; -the cipher suites are nonempty, each fits two bytes, and -there are at most 32767 of them; the compression methods -are nonempty, contain the null method 0, number at most -255, and are exactly [0] when the hello offers TLS 1.3 -(its supported_versions lists 0x0304); every extension is -well formed (its lengths fit their fields, SNI has -distinct entry types and a nonempty host name when -present, ALPN names are nonempty, key share groups are -distinct with nonempty keys, and an opaque extension's -type is none of the four decoded types); no extension -type stands twice; no extension but the last has type 41 -(pre_shared_key); the printed extensions block fits two -bytes of length; and the printed handshake message, its -four header bytes and the body fields, is at most -2^14 = 16384 bytes, the record limit of RFC 8446 section -5.1. +A message is well formed (`Spec.WF`) when the record +version and the legacy version each fit two bytes; the +random holds exactly 32 bytes; the session id holds at +most 32 bytes; the cipher suites are nonempty, each fits +two bytes, and there are at most 32767 of them; the +compression methods are nonempty, contain the null method +0, number at most 255, and are exactly [0] when the hello +offers TLS 1.3 (its supported_versions lists 0x0304); +every extension is well formed (its lengths fit their +fields, SNI has distinct entry types and a nonempty host +name when present, ALPN names are nonempty, key share +groups are distinct with nonempty keys, and an opaque +extension's type is none of the four decoded types); no +extension type stands twice; no extension but the last has +type 41 (pre_shared_key); the printed extensions block +fits two bytes of length; and the printed handshake +message, its four header bytes and the body fields, is at +most 2^14 = 16384 bytes, the record limit of RFC 8446 +section 5.1. + +`Spec.WF` is in `Spec/Defs.lean`, which `bar.toml` lists +among the spec files. The approval covers it with +`Spec.lean`, so what the two round trips mean cannot +change without changing the approved text. The two round trip theorems rest on the proofs in `Proofs/RoundTrip.lean`, where they are @@ -136,14 +143,14 @@ the same functions the theorems are about. ## What is not proved -- That the well formedness predicate is the same as the - rules in `SPEC.md`. Relative to the predicate, the - accepted inputs are fixed exactly: the parser accepts - the printed forms of well formed messages and nothing - else. That the predicate holds every rule of `SPEC.md`, - and no other, is read by the reviewer and checked by the - differential tests in `tests/`, not proved. The - single-input theorems pin one input each. +- That the well formedness predicate, `Spec.WF`, is the + same as the rules in `SPEC.md`. Relative to the + predicate, the accepted inputs are fixed exactly: the + parser accepts the printed forms of well formed messages + and nothing else. That the predicate holds every rule of + `SPEC.md`, and no other, is read by the reviewer and + checked by the differential tests in `tests/`, not + proved. The single-input theorems pin one input each. - That the printer writes the byte layout the RFCs give. The round trips relate the parser and the printer to each other; the accepted examples pin some whole inputs, diff --git a/SPEC.md b/SPEC.md index 8ae9907..96a6628 100644 --- a/SPEC.md +++ b/SPEC.md @@ -176,9 +176,13 @@ slice pins it: Each property a reader can check in the page (`README.md`) names its theorem. The theorems are stated in `Spec.lean` -and proved in `Proofs/SpecProofs.lean`. The example -theorems are single inputs; the tests in `tests/` cover -each rule on many more inputs. +and proved in `Proofs/SpecProofs.lean`. The two round +trips are stated over `Spec.WF` in `Spec/Defs.lean`, which +writes the rules of this page as one predicate on the +message. That file is part of this specification, and the +approval covers it. The example theorems are single +inputs; the tests in `tests/` cover each rule on many more +inputs. Statements about every input: diff --git a/Spec.lean b/Spec.lean index bf4a87a..127bb8d 100644 --- a/Spec.lean +++ b/Spec.lean @@ -7,13 +7,15 @@ proves exactly the statement written here. The `sorry` below is expected in this file only. - The statements use only the definitions in `ClientHello/Value.lean` - and `ClientHello/Parse.lean`, the code under proof named in - `bar.toml`. No definition of their own is needed, so this project - has no `Spec/Defs.lean`. + The statements use the definitions in `ClientHello/Value.lean` and + `ClientHello/Parse.lean`, the code under proof named in `bar.toml`, + and one definition of their own: `Spec.WF`, what a well formed + message is, in `Spec/Defs.lean`. That file is a spec file too, so the + approval fixes what the round trips mean. -/ import ClientHello +import Spec.Defs open ClientHello @@ -21,11 +23,11 @@ open ClientHello The two statements the slice stands on. Each one is the statement of the proved theorem of the same shape in `Proofs/RoundTrip.lean`, over -the same well formedness predicate, `ClientHello.WF`. -/ +the well formedness predicate `Spec.WF` of `Spec/Defs.lean`. -/ /-- Parsing the printed form of a well formed message gives the message back. -/ -theorem Spec.parse_print (m : Message) (hw : WF m) : +theorem Spec.parse_print (m : Message) (hw : Spec.WF m) : parse (print m) = some m := sorry /-- A message the parser took prints back to the bytes it was read @@ -33,7 +35,7 @@ theorem Spec.parse_print (m : Message) (hw : WF m) : nothing, or wrote something shorter, fails the first half. -/ theorem Spec.print_parse {bs : List UInt8} {m : Message} (hparse : parse bs = some m) : - print m = bs ∧ WF m := sorry + print m = bs ∧ Spec.WF m := sorry /-! ## Rules every accepted message meets diff --git a/Spec/Defs.lean b/Spec/Defs.lean new file mode 100644 index 0000000..5b89f33 --- /dev/null +++ b/Spec/Defs.lean @@ -0,0 +1,82 @@ +/- + What a well formed message is: the one definition the statements in + `Spec.lean` use besides the code under proof. + + This file is part of the specification. `bar.toml` lists it among the + spec files, so a reviewer approves it with `Spec.lean` and `SPEC.md`, + and the approval hash pins it. `Spec.parse_print` and + `Spec.print_parse` take their meaning from `Spec.WF`: together they + say the parser accepts exactly the printed forms of the messages + `Spec.WF` describes. If the predicate sat in the code, a change to the + parser together with the same change to the predicate would leave + every statement true and the hash unchanged. + + It reads the data model and the printer of `ClientHello/Value.lean` + (the types, `extType`, and the lengths of printed blocks), which are + code under proof, and nothing of the parser. +-/ + +import ClientHello.Value + +namespace Spec + +open ClientHello + +/-- Well formedness of one extension, at the level the + printer needs: every length it writes fits the field that + holds it, and the rules `SPEC.md` gives for the value + hold. -/ +def ExtWF : Extension → Prop + | .serverName es => + es ≠ [] ∧ + (∀ e ∈ es, e.1 < 256 ∧ e.2.length ≤ 65535 ∧ + (e.1 = 0 → e.2 ≠ [])) ∧ + List.Nodup (es.map Prod.fst) ∧ + (printNameEntries es).length ≤ 65533 + | .alpn ns => + ns ≠ [] ∧ + (∀ n ∈ ns, n ≠ [] ∧ n.length ≤ 255) ∧ + (printAlpnNames ns).length ≤ 65533 + | .supportedVersions vs => + vs ≠ [] ∧ (∀ v ∈ vs, v < 65536) ∧ vs.length ≤ 127 + | .keyShare ss => + (∀ s ∈ ss, s.1 < 65536 ∧ s.2 ≠ [] ∧ + s.2.length ≤ 65535) ∧ + List.Nodup (ss.map Prod.fst) ∧ + (printShares ss).length ≤ 65533 + | .opaque t v => + ¬ (t = 0 ∨ t = 16 ∨ t = 43 ∨ t = 51) ∧ + t < 65536 ∧ v.length ≤ 65535 + +/-- A well formed message: every number fits the field that + holds it, every byte block holds the length its field + demands, the cipher suites and compression methods meet + their rules, every extension is well formed, no + extension type stands twice, pre_shared_key (type 41) + stands last if present (RFC 8446 section 4.2.11), a + hello with a supported_versions extension that lists + 0x0304 (772), that is one that offers TLS 1.3, carries + exactly the null compression method (RFC 8446 section + 4.1.2), and the handshake message (four header bytes and + the body fields) fits a record of at most 2^14 = 16384 + bytes (RFC 8446 section 5.1). -/ +def WF (m : Message) : Prop := + m.recordVersion < 65536 ∧ + m.hello.legacyVersion < 65536 ∧ + m.hello.random.length = 32 ∧ + m.hello.sessionId.length ≤ 32 ∧ + m.hello.cipherSuites ≠ [] ∧ + (∀ v ∈ m.hello.cipherSuites, v < 65536) ∧ + m.hello.cipherSuites.length ≤ 32767 ∧ + m.hello.compressionMethods ≠ [] ∧ + (0 : UInt8) ∈ m.hello.compressionMethods ∧ + m.hello.compressionMethods.length ≤ 255 ∧ + (∀ e ∈ m.hello.extensions, ExtWF e) ∧ + List.Nodup (m.hello.extensions.map extType) ∧ + 41 ∉ (m.hello.extensions.dropLast).map extType ∧ + (∀ vs, Extension.supportedVersions vs ∈ m.hello.extensions → + 772 ∈ vs → m.hello.compressionMethods = [0]) ∧ + (printExts m.hello.extensions).length ≤ 65535 ∧ + (printBodyFields m.hello).length ≤ 16380 + +end Spec diff --git a/bar.toml b/bar.toml index 3260b5d..1c9efca 100644 --- a/bar.toml +++ b/bar.toml @@ -12,27 +12,32 @@ spec_authors = ["abu-aska", "zero-aska"] entry_points = ["Main.lean"] [spec] -files = ["SPEC.md", "Spec.lean"] +# Spec/Defs.lean holds Spec.WF, the well formedness predicate the round +# trips are stated over, so that the approval pins what they mean. +files = ["SPEC.md", "Spec.lean", "Spec/Defs.lean"] # The code under proof: the functions the statements are about. code = [ - # The data types the statements are about, and their constructors. + # The data types the statements are about, their constructors, and + # the case split on an extension that Spec.ExtWF's match compiles to. "ClientHello.Message", "ClientHello.Hello", "ClientHello.Extension", "ClientHello.Extension.serverName", "ClientHello.Extension.alpn", "ClientHello.Extension.supportedVersions", "ClientHello.Extension.keyShare", - "ClientHello.Extension.opaque", - # The fields the statements about every accepted message read. - "ClientHello.Message.hello", "ClientHello.Hello.extensions", - "ClientHello.Hello.compressionMethods", + "ClientHello.Extension.opaque", "ClientHello.Extension.casesOn", + # The fields the statements and Spec.WF read. + "ClientHello.Message.recordVersion", "ClientHello.Message.hello", + "ClientHello.Hello.legacyVersion", "ClientHello.Hello.random", + "ClientHello.Hello.sessionId", "ClientHello.Hello.cipherSuites", + "ClientHello.Hello.compressionMethods", "ClientHello.Hello.extensions", # The byte forms and the printer. "ClientHello.be16", "ClientHello.u16", "ClientHello.be24", "ClientHello.u24", "ClientHello.extType", "ClientHello.printPairs", "ClientHello.printNameEntries", "ClientHello.printAlpnNames", "ClientHello.printShares", "ClientHello.printExtValue", "ClientHello.printExt", "ClientHello.printExts", "ClientHello.printBodyFields", "ClientHello.printBody", "ClientHello.print", - # Well formedness, and the parser's test of whether a hello offers - # TLS 1.3. offersTls13 is listed because parseBodyFields calls it; no - # statement reads it. - "ClientHello.ExtWF", "ClientHello.WF", "ClientHello.offersTls13", + # The parser's test of whether a hello offers TLS 1.3. It is listed + # because parseBodyFields calls it; no statement and nothing in the + # spec files reads it. + "ClientHello.offersTls13", # The length checked readers and the parser. "ClientHello.getU16", "ClientHello.withU8", "ClientHello.withU16", "ClientHello.withU24", "ClientHello.withBytes", "ClientHello.parsePairs", From 7bf9b399da8ba116f0e0603519ad5cf5cb9410b0 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 22:16:00 +0000 Subject: [PATCH 15/19] State that a record of exactly 2^14 bytes is accepted The independent check of the carried branch found that no statement pinned the accept side of the 2^14 record limit: only Spec.rejects_record_overflow (refuse above 16384) and a named test case at 16384 spoke to it, so a parser that refused a legal record of exactly 16384 bytes could meet every statement. Spec.accepts_record_at_limit says that for every 16324-byte value v, the hello of Spec.accepts_supported_versions with a padding extension (type 21, carried opaque) holding v after its supported_versions, and the lengths that cover it, is accepted and prints back as the same bytes. That input is 16389 bytes with record length exactly 16384. It is proved from parse_print with a Spec.WF witness. A parser that stops at 16383 refuses it, so the statement is false for such a program. README and SPEC tables (now "every input, or every input of one form"), comparator.json and SPEC.md's record layer ("a length of exactly 16384 is allowed") follow. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Proofs/SpecProofs.lean | 32 ++++++++++++++++++++++++++++++++ README.md | 13 +++++++------ SPEC.md | 6 ++++-- Spec.lean | 19 +++++++++++++++++++ comparator.json | 1 + 5 files changed, 63 insertions(+), 8 deletions(-) diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean index e037beb..6fafd6d 100644 --- a/Proofs/SpecProofs.lean +++ b/Proofs/SpecProofs.lean @@ -70,6 +70,38 @@ theorem Spec.accepts_psk_last : decide +kernel +theorem Spec.accepts_record_at_limit (v : List UInt8) + (hv : v.length = 16324) : + (parse (([22, 3, 1, 64, 0, 1, 0, 63, 252, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 63, 209, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 21, 63, 196] : List UInt8) ++ v)).map print = + some (([22, 3, 1, 64, 0, 1, 0, 63, 252, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 63, 209, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 21, 63, 196] : List UInt8) ++ v) := by + let h : Hello := ⟨771, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31], [], + [4865], [0], [.supportedVersions [772, 771], .opaque 21 v]⟩ + let m : Message := ⟨769, h⟩ + have hfields : (printBodyFields h).length = 16380 := by + simp [h, printBodyFields, printExts, printExt, printExtValue, + printPairs, be16, hv] + have hp : print m = ([22, 3, 1, 64, 0, 1, 0, 63, 252, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 63, 209, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 21, 63, 196] : List UInt8) ++ v := by + simp [m, h, print, printBody, printBodyFields, printExts, printExt, + printExtValue, printPairs, extType, be16, be24, hv] + have hw : Spec.WF m := by + refine ⟨?_, ?_, rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, + fun _ _ _ => rfl, ?_, Nat.le_of_eq hfields⟩ + all_goals first + | (dsimp only [m, h]; decide) + | skip + · intro e he + simp only [m, h, List.mem_cons, List.not_mem_nil, or_false] at he + rcases he with rfl | rfl + · simp [Spec.ExtWF] + · simp [Spec.ExtWF, hv] + · simp [m, h, extType] + · simp [m, h, extType] + · simp [m, h, printExts, printExt, printExtValue, printPairs, be16, hv] + rw [← hp, ClientHello.Proofs.parse_print m hw] + rfl + + theorem Spec.rejects_empty : (parse ([] : List UInt8)).isSome = false := by decide +kernel diff --git a/README.md b/README.md index c986916..824c401 100644 --- a/README.md +++ b/README.md @@ -44,22 +44,23 @@ where they end in `sorry`) and proved in `Proofs/SpecProofs.lean`, under the same names. `comparator.json` lists all of them. -Statements about every input: +Statements about every input, or every input of one form: | Claim | Theorem | |-------|---------| | Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | | A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | +| A record of exactly 2^14 = 16384 bytes is accepted and writes back as the same bytes. The input is the hello of `Spec.accepts_supported_versions` with a padding extension (type 21) after its supported_versions, whose value is any 16324 bytes, and the lengths that cover it, 16389 bytes in all. | `Spec.accepts_record_at_limit` | | Every accepted hello with a supported_versions extension that lists 0x0304, in any position (a hello that offers TLS 1.3), has exactly the compression methods [0]. | `Spec.tls13_compression_null` | | In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | Together, the two round trips say that the parser accepts -exactly the printed forms of well formed messages, so every -rule that is part of well formedness (below) holds for -every accepted input. The three statements after them state -three of those rules on their own, so that each has a -theorem of its own. +exactly the printed forms of well formed messages, so +every rule that is part of well formedness (below) holds +for every accepted input. The statements after them state +the record limit from both sides and two more of those +rules on their own, so that each has a theorem of its own. Single inputs. Each theorem below is about the one input written out in `Spec.lean`, and each claim says what that diff --git a/SPEC.md b/SPEC.md index 96a6628..fd68460 100644 --- a/SPEC.md +++ b/SPEC.md @@ -23,7 +23,8 @@ A message is one TLS record: - A length above 2^14 = 16384 rejects, whatever follows. RFC 8446 section 5.1 says the length "MUST NOT exceed 2^14 bytes" and that a receiver answers a longer record - with a record_overflow alert. + with a record_overflow alert. A length of exactly 16384 + is allowed. - A body shorter than the declared length rejects. - Bytes after the record reject. The decoder takes exactly one record; a stream reader is later work. @@ -184,13 +185,14 @@ approval covers it. The example theorems are single inputs; the tests in `tests/` cover each rule on many more inputs. -Statements about every input: +Statements about every input, or every input of one form: | Property | Theorem | |-------|---------| | Parsing the printed form of a well formed message gives the message back. | `Spec.parse_print` | | Printing a message the parser took gives the same bytes it was read from, and the message is well formed. | `Spec.print_parse` | | A record whose length field is above 2^14 = 16384 is refused, whatever else the input holds. | `Spec.rejects_record_overflow` | +| A record of exactly 2^14 = 16384 bytes is accepted and writes back as the same bytes. The input is the hello of `Spec.accepts_supported_versions` with a padding extension (type 21) after its supported_versions, whose value is any 16324 bytes, and the lengths that cover it, 16389 bytes in all. | `Spec.accepts_record_at_limit` | | Every accepted hello with a supported_versions extension that lists 0x0304, in any position (a hello that offers TLS 1.3), has exactly the compression methods [0]. | `Spec.tls13_compression_null` | | In every accepted hello, no extension but the last has type 41: pre_shared_key, when present, is the last extension. | `Spec.psk_last` | diff --git a/Spec.lean b/Spec.lean index 127bb8d..bd730cd 100644 --- a/Spec.lean +++ b/Spec.lean @@ -102,6 +102,25 @@ theorem Spec.accepts_psk_last : (parse ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8)).map print = some ([22, 3, 1, 0, 62, 1, 0, 0, 58, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 15, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 41, 0, 2, 0, 0] : List UInt8) := sorry +/-! ## The record limit, accept side + +`Spec.rejects_record_overflow` refuses every record length above 2^14. +This is the other side of that limit: a record of exactly 2^14 bytes is +accepted, whatever the bytes that fill it. -/ + +/-- A record of exactly 2^14 = 16384 bytes, the most RFC 8446 section 5.1 + allows, is accepted and writes back as the same bytes. The input is + the hello of `Spec.accepts_supported_versions` with a second extension + after its supported_versions: type 21 (padding, RFC 7685, carried + opaque) whose value is any 16324 bytes `v`. The lengths that cover it + change to match: the record length field is 16384 (64, 0), the + handshake length 16380, the extensions block 16337 and the padding + value 16324. The input is 16389 bytes long. -/ +theorem Spec.accepts_record_at_limit (v : List UInt8) + (hv : v.length = 16324) : + (parse (([22, 3, 1, 64, 0, 1, 0, 63, 252, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 63, 209, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 21, 63, 196] : List UInt8) ++ v)).map print = + some (([22, 3, 1, 64, 0, 1, 0, 63, 252, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 63, 209, 0, 43, 0, 5, 4, 3, 4, 3, 3, 0, 21, 63, 196] : List UInt8) ++ v) := sorry + /-! ## Refused inputs Single inputs the parser refuses, one for each headline rule of diff --git a/comparator.json b/comparator.json index 90aa33d..ee70f03 100644 --- a/comparator.json +++ b/comparator.json @@ -11,6 +11,7 @@ "Spec.accepts_key_share_empty_list", "Spec.accepts_tls12_compression", "Spec.accepts_psk_last", + "Spec.accepts_record_at_limit", "Spec.rejects_empty", "Spec.rejects_short_header", "Spec.rejects_record_length_zero", From 7bab388526b684ce966a188aaec534dbc4b7ab65 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 22:16:42 +0000 Subject: [PATCH 16/19] Describe the two supported_versions refusal inputs exactly The independent check of the carried branch found that two single-input claims, rewritten earlier to describe their input exactly, misstated it in SPEC.md's own terms. "supported_versions value has the odd length 3" names a value that is the 4 bytes [3, 3, 4, 3]; only its list length byte is 3. "value has length 0" names the 1 byte [0], whose list length byte is 0. The Spec.lean doc comment for rejects_supported_versions_odd said the value had an odd byte length, but its byte length is 4. The README and SPEC rows, both Spec.lean doc comments and the two named test labels now give the value bytes and say that the list length byte is 3 (odd, with 3 bytes after it) or 0 (no version listed). The statements themselves are unchanged. The test record changes only in those two labels. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 4 ++-- SPEC.md | 4 ++-- Spec.lean | 9 +++++++-- tests/TEST-RESULTS.md | 4 ++-- tests/run_tests.py | 5 +++-- 5 files changed, 16 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index 824c401..8d40096 100644 --- a/README.md +++ b/README.md @@ -97,8 +97,8 @@ do not state the rule for every input. | A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | | A hello whose key_share carries two entries for group 29 is refused. | `Spec.rejects_duplicate_key_share_group` | | A hello whose key_share entry has empty key exchange bytes is refused. | `Spec.rejects_key_share_empty_key` | -| A hello whose supported_versions value has the odd length 3 is refused. | `Spec.rejects_supported_versions_odd` | -| A hello whose supported_versions value has length 0 is refused. | `Spec.rejects_supported_versions_zero` | +| A hello whose one extension is supported_versions with the 4-byte value 3, 3, 4, 3 is refused: its list length byte is 3, which is odd, and 3 bytes follow it. | `Spec.rejects_supported_versions_odd` | +| A hello whose one extension is supported_versions with the 1-byte value 0 is refused: its list length byte is 0, so it lists no version. | `Spec.rejects_supported_versions_zero` | | A hello whose ALPN value holds one protocol name of length 0 is refused. | `Spec.rejects_alpn_empty_name` | | A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | | A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | diff --git a/SPEC.md b/SPEC.md index fd68460..10a171a 100644 --- a/SPEC.md +++ b/SPEC.md @@ -229,8 +229,8 @@ it: | A hello whose one extension declares 10 value bytes where its block holds 3 is refused. | `Spec.rejects_extension_overrun` | | A hello whose key_share carries two entries for group 29 is refused. | `Spec.rejects_duplicate_key_share_group` | | A hello whose key_share entry has empty key exchange bytes is refused. | `Spec.rejects_key_share_empty_key` | -| A hello whose supported_versions value has the odd length 3 is refused. | `Spec.rejects_supported_versions_odd` | -| A hello whose supported_versions value has length 0 is refused. | `Spec.rejects_supported_versions_zero` | +| A hello whose one extension is supported_versions with the 4-byte value 3, 3, 4, 3 is refused: its list length byte is 3, which is odd, and 3 bytes follow it. | `Spec.rejects_supported_versions_odd` | +| A hello whose one extension is supported_versions with the 1-byte value 0 is refused: its list length byte is 0, so it lists no version. | `Spec.rejects_supported_versions_zero` | | A hello whose ALPN value holds one protocol name of length 0 is refused. | `Spec.rejects_alpn_empty_name` | | A hello whose server_name value holds two host_name entries is refused. | `Spec.rejects_sni_second_host_name` | | A hello whose server_name list length (99) does not cover the rest of the value is refused. | `Spec.rejects_sni_list_length` | diff --git a/Spec.lean b/Spec.lean index bd730cd..f36fb0b 100644 --- a/Spec.lean +++ b/Spec.lean @@ -238,11 +238,16 @@ theorem Spec.rejects_duplicate_key_share_group : theorem Spec.rejects_key_share_empty_key : (parse ([22, 3, 1, 0, 57, 1, 0, 0, 53, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 10, 0, 51, 0, 6, 0, 4, 0, 29, 0, 0] : List UInt8)).isSome = false := sorry -/-- A supported_versions value with an odd byte length is refused. -/ +/-- A hello whose one extension is supported_versions with the 4-byte + value [3, 3, 4, 3] is refused. Its list length byte is 3, which is odd, + and the 3 bytes after it match that length, so the odd length + is what refuses it. -/ theorem Spec.rejects_supported_versions_odd : (parse ([22, 3, 1, 0, 55, 1, 0, 0, 51, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 8, 0, 43, 0, 4, 3, 3, 4, 3] : List UInt8)).isSome = false := sorry -/-- A supported_versions value with a length of 0 is refused. -/ +/-- A hello whose one extension is supported_versions with the 1-byte + value [0] is refused. Its list length byte is 0, so it lists no + version. -/ theorem Spec.rejects_supported_versions_zero : (parse ([22, 3, 1, 0, 52, 1, 0, 0, 48, 3, 3, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0, 0, 2, 19, 1, 1, 0, 0, 5, 0, 43, 0, 1, 0] : List UInt8)).isSome = false := sorry diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md index fab384f..e913f5d 100644 --- a/tests/TEST-RESULTS.md +++ b/tests/TEST-RESULTS.md @@ -51,8 +51,8 @@ Of the 3200 generated messages, the oracle accepts 1266 and rejects 1934. - pre_shared_key before key_share: reject (157 bytes) - pre_shared_key first of two: reject (109 bytes) - missing extensions block: reject (50 bytes) -- supported versions odd length: reject (60 bytes) -- supported versions length zero: reject (57 bytes) +- supported versions value 03 03 04 03: list length byte 3, odd: reject (60 bytes) +- supported versions value 00: list length byte 0: reject (57 bytes) - ALPN empty name: reject (59 bytes) - ALPN list length mismatch: reject (61 bytes) - ALPN empty list: reject (58 bytes) diff --git a/tests/run_tests.py b/tests/run_tests.py index 9b7afb2..46f020c 100644 --- a/tests/run_tests.py +++ b/tests/run_tests.py @@ -519,10 +519,11 @@ def named_cases(): False)) cases.append(("missing extensions block", build_hello(ext_block=False), False)) - cases.append(("supported versions odd length", + cases.append(("supported versions value 03 03 04 03: list length " + "byte 3, odd", build_hello(exts=[(43, bytes([3, 3, 4, 3]))]), False)) - cases.append(("supported versions length zero", + cases.append(("supported versions value 00: list length byte 0", build_hello(exts=[(43, bytes([0]))]), False)) cases.append(("ALPN empty name", build_hello(exts=[(16, be16(1) + b"\x00")]), From 3ed503d976db6f8f64581f7298dc39305f3c0fec Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 23:24:45 +0000 Subject: [PATCH 17/19] List the three nonempty list conjuncts of Spec.WF in the README The plain-words definition of Spec.WF left out that a server_name entry list, an ALPN name list and a supported_versions list must each be nonempty, which Spec/Defs.lean requires. SPEC.md already states all three in its per-extension rules. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- README.md | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 8d40096..7f21c61 100644 --- a/README.md +++ b/README.md @@ -112,9 +112,11 @@ compression methods are nonempty, contain the null method 0, number at most 255, and are exactly [0] when the hello offers TLS 1.3 (its supported_versions lists 0x0304); every extension is well formed (its lengths fit their -fields, SNI has distinct entry types and a nonempty host -name when present, ALPN names are nonempty, key share -groups are distinct with nonempty keys, and an opaque +fields, an SNI entry list is nonempty with distinct entry +types and a nonempty host name when present, an ALPN name +list is nonempty and its names are nonempty, a +supported_versions list is nonempty, key share groups are +distinct with nonempty keys, and an opaque extension's type is none of the four decoded types); no extension type stands twice; no extension but the last has type 41 (pre_shared_key); the printed extensions block From f3b9f7a6b4e5a992988f6382d7d702bfe27f3346 Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 28 Oct 2026 23:24:46 +0000 Subject: [PATCH 18/19] Say which bytes vary in the record limit section header The header said a record of exactly 2^14 bytes is accepted whatever bytes fill it, but Spec.accepts_record_at_limit fixes the first 65 bytes and lets only the 16324 padding value bytes vary. Comment only; no statement changed. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- Spec.lean | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Spec.lean b/Spec.lean index f36fb0b..5953818 100644 --- a/Spec.lean +++ b/Spec.lean @@ -105,8 +105,9 @@ theorem Spec.accepts_psk_last : /-! ## The record limit, accept side `Spec.rejects_record_overflow` refuses every record length above 2^14. -This is the other side of that limit: a record of exactly 2^14 bytes is -accepted, whatever the bytes that fill it. -/ +This is the other side of that limit: one record of exactly 2^14 bytes +is accepted. Its first 65 bytes are fixed; the 16324 bytes of its padding +value may be any bytes. -/ /-- A record of exactly 2^14 = 16384 bytes, the most RFC 8446 section 5.1 allows, is accepted and writes back as the same bytes. The input is From d9932d66cb3be808ea003447622cafb10c5ce4cb Mon Sep 17 00:00:00 2001 From: Claude Date: Thu, 29 Oct 2026 19:39:57 +0000 Subject: [PATCH 19/19] Declare the Apache-2.0 package license in lakefile.toml The org's license policy (mission#9, mission#26) asks each Lake package to set license = "Apache-2.0". The LICENSE file came from main. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01AovXVgJBHGiN44TxQM4dcd --- lakefile.toml | 1 + 1 file changed, 1 insertion(+) diff --git a/lakefile.toml b/lakefile.toml index 700b760..f719108 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -1,5 +1,6 @@ name = "clienthello" version = "0.1.0" +license = "Apache-2.0" defaultTargets = ["ClientHello", "Proofs", "clienthello"] [[lean_lib]]