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/.gitignore b/.gitignore new file mode 100644 index 0000000..ae73679 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.lake/ +__pycache__/ diff --git a/Http.lean b/Http.lean new file mode 100644 index 0000000..d510264 --- /dev/null +++ b/Http.lean @@ -0,0 +1,6 @@ +import Http.Types +import Http.Abnf +import Http.Match +import Http.Grammar +import Http.Head +import Http.Framing diff --git a/Http/Abnf.lean b/Http/Abnf.lean new file mode 100644 index 0000000..9e3f139 --- /dev/null +++ b/Http/Abnf.lean @@ -0,0 +1,87 @@ +/- + The grammar notation: a small language of regular expressions over + octets, enough to write the ABNF rules of RFC 3986, RFC 9110 and + RFC 9112 that this library reads. Part of the approved specification, + with `Spec.lean`, since the grammar in `Spec/Rules.lean` is written in + it and `Spec/Abnf.lean` gives its meaning. + + Each ABNF form (RFC 5234) has a counterpart here: + - a terminal value, `%x41`, is `byte`, and a range, `%x41-5A`, is + `range`; + - concatenation is `cat`, or `seq` for several; + - alternation, `/`, is `alt`, or `any` for several; + - repetition: `*rule` is `star`, `1*rule` is `plus`, `nrule` is + `rep n`, `*n rule` is `upTo n`, `n*m rule` is `between n m`; + - an optional sequence, `[ rule ]`, is `opt`; + - a quoted string is case-insensitive (section 2.3), and is `litCI`; + a case-sensitive one, `%s"..."` (RFC 7405), is `lit`. +-/ + +namespace Http + +/-- A regular expression over octets. -/ +inductive Re where + /-- Matches nothing. -/ + | empty + /-- Matches the empty string. -/ + | eps + /-- Matches one octet from `lo` to `hi`. -/ + | range (lo hi : UInt8) + /-- Matches a string of `a` followed by a string of `b`. -/ + | cat (a b : Re) + /-- Matches what `a` or `b` matches. -/ + | alt (a b : Re) + /-- Matches zero or more strings of `a`, one after another. -/ + | star (a : Re) + deriving DecidableEq, Repr + +namespace Re + +/-- One octet. -/ +def byte (c : UInt8) : Re := range c c + +/-- Each of the rules in turn. -/ +def seq : List Re → Re + | [] => eps + | [r] => r + | r :: rs => cat r (seq rs) + +/-- Any one of the rules. -/ +def any : List Re → Re + | [] => empty + | [r] => r + | r :: rs => alt r (any rs) + +/-- `[ r ]`. -/ +def opt (r : Re) : Re := alt eps r + +/-- `1*r`. -/ +def plus (r : Re) : Re := cat r (star r) + +/-- `n r`: exactly `n` times. -/ +def rep (n : Nat) (r : Re) : Re := seq (List.replicate n r) + +/-- `*n r`: at most `n` times. -/ +def upTo (n : Nat) (r : Re) : Re := seq (List.replicate n (opt r)) + +/-- `n*m r`: from `n` to `m` times. -/ +def between (n m : Nat) (r : Re) : Re := cat (rep n r) (upTo (m - n) r) + +/-- A string of ASCII characters, matched exactly. -/ +def lit (s : String) : Re := seq (s.toList.map fun c => byte c.toNat.toUInt8) + +/-- An ASCII letter in either case, or any other character as itself. -/ +def charCI (c : Char) : Re := + if 'a' ≤ c ∧ c ≤ 'z' then alt (byte c.toNat.toUInt8) (byte (c.toNat - 32).toUInt8) + else if 'A' ≤ c ∧ c ≤ 'Z' then alt (byte c.toNat.toUInt8) (byte (c.toNat + 32).toUInt8) + else byte c.toNat.toUInt8 + +/-- A quoted ABNF string: ASCII letters match in either case. -/ +def litCI (s : String) : Re := seq (s.toList.map charCI) + +/-- Any one of the characters of the string. -/ +def oneOf (s : String) : Re := any (s.toList.map fun c => byte c.toNat.toUInt8) + +end Re + +end Http diff --git a/Http/Framing.lean b/Http/Framing.lean new file mode 100644 index 0000000..3413065 --- /dev/null +++ b/Http/Framing.lean @@ -0,0 +1,117 @@ +/- + Whether this library accepts a request head, and how the body after it + is framed (RFC 9112, sections 3.2, 6.1 and 6.3, and RFC 9110, sections + 4.2, 5.2, 5.6.1.2 and 9.3.6). +-/ + +import Http.Head + +namespace Http + +/-- ASCII lower case. -/ +def lower (c : UInt8) : UInt8 := if 0x41 ≤ c && c ≤ 0x5A then c + 0x20 else c + +/-- Whether the field's name, without regard to ASCII case, is `n`, + given in lower case. -/ +def Field.isNamed (f : Field) (n : List UInt8) : Bool := f.name.map lower == n + +/-- The number a string of decimal digits writes, one digit at a time. + Each step takes time that grows with the number so far, so the time + grows with the square of the number of digits. -/ +def decimal (ds : List UInt8) : Nat := ds.foldl (fun n d => 10 * n + (d.toNat - 0x30)) 0 + +/-- `decimal` of the `n` digits `ds`, by halves, for at most `fuel` + levels: the number that `hi ++ lo` writes is the number `hi` writes + times 10 to the length of `lo`, plus the number `lo` writes. Up to 18 + digits are read one at a time. -/ +def decimalBy : Nat → Nat → List UInt8 → Nat + | 0, _, ds => decimal ds + | fuel + 1, n, ds => + if n ≤ 18 then decimal ds + else + let (hi, lo) := ds.splitAt (n / 2) + decimalBy fuel (n / 2) hi * 10 ^ (n - n / 2) + decimalBy fuel (n - n / 2) lo + +/-- The number a string of decimal digits writes, read by halves, so + that the work is in multiplications of large numbers, not in one + step per digit. -/ +def decimalFast (ds : List UInt8) : Nat := decimalBy ds.length ds.length ds + +/-- Whether a string of decimal digits writes a number from 1 to 65535. + After the leading zeros, more than five digits write 100000 or more, + so at most five digits are converted. -/ +def portInRange (ds : List UInt8) : Bool := + let ds := ds.dropWhile (· == 0x30) + if ds.length ≤ 5 then 1 ≤ decimal ds && decimal ds ≤ 65535 else false + +/-- `host`, `content-length` and `transfer-encoding`. -/ +def hostName : List UInt8 := [0x68, 0x6F, 0x73, 0x74] +def contentLengthName : List UInt8 := + [0x63, 0x6F, 0x6E, 0x74, 0x65, 0x6E, 0x74, 0x2D, 0x6C, 0x65, 0x6E, 0x67, 0x74, 0x68] +def transferEncodingName : List UInt8 := + [0x74, 0x72, 0x61, 0x6E, 0x73, 0x66, 0x65, 0x72, 0x2D, 0x65, 0x6E, 0x63, 0x6F, 0x64, 0x69, 0x6E, + 0x67] + +/-- `CONNECT`. -/ +def connectName : List UInt8 := [0x43, 0x4F, 0x4E, 0x4E, 0x45, 0x43, 0x54] + +/-- The digits at the end of `t`: in an authority-form target, its port. -/ +def portOf (t : List UInt8) : List UInt8 := (t.reverse.takeWhile isDigit).reverse + +/-- Whether the head keeps the rule of RFC 9110 section 9.3.6 for + CONNECT: its target is `uri-host ":" port`, with a host that is not + empty and a port from 1 to 65535. Any other method keeps it. -/ +def Head.connectOK (h : Head) : Bool := + h.method != connectName || + (Grammar.connectTarget.isMatch h.target && portInRange (portOf h.target)) + +/-- `http:` and `https:`. -/ +def httpColon : List UInt8 := [0x68, 0x74, 0x74, 0x70, 0x3A] +def httpsColon : List UInt8 := [0x68, 0x74, 0x74, 0x70, 0x73, 0x3A] + +/-- Whether the head keeps the rule of RFC 9110 sections 4.2.1, 4.2.2 and + 4.2.4: a target whose scheme is http or https, in any case, is such a + URI with a host that is not empty and no userinfo. A CONNECT target + is in authority-form, which has no scheme, so a CONNECT keeps it. -/ +def Head.httpTargetOK (h : Head) : Bool := + h.method == connectName || + !(httpColon.isPrefixOf (h.target.map lower) || httpsColon.isPrefixOf (h.target.map lower)) || + Grammar.httpTarget.isMatch h.target + +/-- The framing of the body after the head by the rules of RFC 9112 + section 6.3, or `none` when this library refuses the request: a + major version other than 1, a missing, + repeated or invalid Host or one with an empty host, a CONNECT with + an empty host or without a valid port, an http or https target with + no authority, an empty host or userinfo, Transfer-Encoding together + with Content-Length, Transfer-Encoding in HTTP/1.0 or with a value + other than a list of the one coding `chunked`, or Content-Length + other than one string of digits. -/ +def Head.framingCore (h : Head) : Option Framing := + let hosts := h.fields.filter (·.isNamed hostName) + if h.major != 1 || hosts.length > 1 || (1 ≤ h.minor && hosts.length != 1) || + !hosts.all (fun f => Grammar.hostField.isMatch f.value) then none + else if !h.connectOK || !h.httpTargetOK then none + else + match h.fields.filter (·.isNamed transferEncodingName), + h.fields.filter (·.isNamed contentLengthName) with + | [], [] => some (.length 0) + | [], [f] => if !f.value.isEmpty && f.value.all isDigit then some (.length (decimalFast f.value)) else none + | t :: ts, [] => + if 1 ≤ h.minor && Grammar.chunkedList.isMatch (List.intercalate [0x2C] ((t :: ts).map (·.value))) + then some .chunked else none + | _, _ => none + +/-- The framing of the body after the head, or `none` when this library + refuses the request: when `framingCore` refuses it, when the target + begins with `:`, which in a `request-target` is an authority-form + target with an empty host, and when a CONNECT has content, that is + Transfer-Encoding or a Content-Length that is not 0. -/ +def Head.framing (h : Head) : Option Framing := + match h.framingCore with + | none => none + | some fr => + if h.target.head? == some 0x3A || (h.method == connectName && fr != .length 0) then none + else some fr + +end Http diff --git a/Http/Grammar.lean b/Http/Grammar.lean new file mode 100644 index 0000000..c9631d7 --- /dev/null +++ b/Http/Grammar.lean @@ -0,0 +1,208 @@ +/- + The grammar of the request target, the Host field and a + Transfer-Encoding list, for the code: the rules that `isMatch` checks + a target, an http or https target, a CONNECT target, a Host value and + a Transfer-Encoding value against. + `Proofs/` shows each is the rule of the same name in + `Spec/Rules.lean`, and that a `connectTarget` is a host that is not + empty, a colon and a port. +-/ + +import Http.Abnf + +open Http.Re + +namespace Http.Grammar + +/-! ## RFC 5234, Appendix B.1 -/ + +/-- `ALPHA = %x41-5A / %x61-7A ; A-Z / a-z` -/ +def ALPHA : Re := alt (range 0x41 0x5A) (range 0x61 0x7A) + +/-- `DIGIT = %x30-39 ; 0-9` -/ +def DIGIT : Re := range 0x30 0x39 + +/-- `HEXDIG = DIGIT / "A" / "B" / "C" / "D" / "E" / "F"` -/ +def HEXDIG : Re := + any [DIGIT, litCI "A", litCI "B", litCI "C", litCI "D", litCI "E", litCI "F"] + +/-! ## RFC 3986, Appendix A -/ + +/-- `unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"` -/ +def unreserved : Re := any [ALPHA, DIGIT, litCI "-", litCI ".", litCI "_", litCI "~"] + +/-- `pct-encoded = "%" HEXDIG HEXDIG` -/ +def pctEncoded : Re := seq [litCI "%", HEXDIG, HEXDIG] + +/-- `sub-delims = "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "="` -/ +def subDelims : Re := + any [litCI "!", litCI "$", litCI "&", litCI "'", litCI "(", litCI ")", litCI "*", litCI "+", + litCI ",", litCI ";", litCI "="] + +/-- `pchar = unreserved / pct-encoded / sub-delims / ":" / "@"` -/ +def pchar : Re := any [unreserved, pctEncoded, subDelims, litCI ":", litCI "@"] + +/-- `segment = *pchar` -/ +def segment : Re := star pchar + +/-- `segment-nz = 1*pchar` -/ +def segmentNz : Re := plus pchar + +/-- `query = *( pchar / "/" / "?" )` -/ +def query : Re := star (any [pchar, litCI "/", litCI "?"]) + +/-- `scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )` -/ +def scheme : Re := cat ALPHA (star (any [ALPHA, DIGIT, litCI "+", litCI "-", litCI "."])) + +/-- `userinfo = *( unreserved / pct-encoded / sub-delims / ":" )` -/ +def userinfo : Re := star (any [unreserved, pctEncoded, subDelims, litCI ":"]) + +/-- `h16 = 1*4HEXDIG` -/ +def h16 : Re := between 1 4 HEXDIG + +/-- `dec-octet = DIGIT / %x31-39 DIGIT / "1" 2DIGIT / "2" %x30-34 DIGIT / + "25" %x30-35` -/ +def decOctet : Re := + any [DIGIT, cat (range 0x31 0x39) DIGIT, cat (litCI "1") (rep 2 DIGIT), + seq [litCI "2", range 0x30 0x34, DIGIT], cat (litCI "25") (range 0x30 0x35)] + +/-- `IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet` -/ +def IPv4address : Re := + seq [decOctet, litCI ".", decOctet, litCI ".", decOctet, litCI ".", decOctet] + +/-- `ls32 = ( h16 ":" h16 ) / IPv4address` -/ +def ls32 : Re := alt (seq [h16, litCI ":", h16]) IPv4address + +/-- `h16 ":"`, which `IPv6address` repeats. -/ +def h16c : Re := cat h16 (litCI ":") + +/-- ``` + IPv6address = 6( h16 ":" ) ls32 + / "::" 5( h16 ":" ) ls32 + / [ h16 ] "::" 4( h16 ":" ) ls32 + / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 + / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 + / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 + / [ *4( h16 ":" ) h16 ] "::" ls32 + / [ *5( h16 ":" ) h16 ] "::" h16 + / [ *6( h16 ":" ) h16 ] "::" + ``` -/ +def IPv6address : Re := + any [ + cat (rep 6 h16c) ls32, + seq [litCI "::", rep 5 h16c, ls32], + seq [opt h16, litCI "::", rep 4 h16c, ls32], + seq [opt (cat (upTo 1 h16c) h16), litCI "::", rep 3 h16c, ls32], + seq [opt (cat (upTo 2 h16c) h16), litCI "::", rep 2 h16c, ls32], + seq [opt (cat (upTo 3 h16c) h16), litCI "::", h16, litCI ":", ls32], + seq [opt (cat (upTo 4 h16c) h16), litCI "::", ls32], + seq [opt (cat (upTo 5 h16c) h16), litCI "::", h16], + cat (opt (cat (upTo 6 h16c) h16)) (litCI "::")] + +/-- `IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )` -/ +def IPvFuture : Re := + seq [litCI "v", plus HEXDIG, litCI ".", plus (any [unreserved, subDelims, litCI ":"])] + +/-- `IP-literal = "[" ( IPv6address / IPvFuture ) "]"` -/ +def IPliteral : Re := seq [litCI "[", alt IPv6address IPvFuture, litCI "]"] + +/-- `reg-name = *( unreserved / pct-encoded / sub-delims )` -/ +def regName : Re := star (any [unreserved, pctEncoded, subDelims]) + +/-- `host = IP-literal / IPv4address / reg-name` -/ +def host : Re := any [IPliteral, IPv4address, regName] + +/-- `port = *DIGIT` -/ +def port : Re := star DIGIT + +/-- `authority = [ userinfo "@" ] host [ ":" port ]` -/ +def authority : Re := + seq [opt (cat userinfo (litCI "@")), host, opt (cat (litCI ":") port)] + +/-- `path-abempty = *( "/" segment )` -/ +def pathAbempty : Re := star (cat (litCI "/") segment) + +/-- `path-absolute = "/" [ segment-nz *( "/" segment ) ]` -/ +def pathAbsolute : Re := cat (litCI "/") (opt (cat segmentNz pathAbempty)) + +/-- `path-rootless = segment-nz *( "/" segment )` -/ +def pathRootless : Re := cat segmentNz pathAbempty + +/-- `path-empty = 0` -/ +def pathEmpty : Re := eps + +/-- `hier-part = "//" authority path-abempty / path-absolute / path-rootless / + path-empty` -/ +def hierPart : Re := + any [seq [litCI "//", authority, pathAbempty], pathAbsolute, pathRootless, + pathEmpty] + +/-- `absolute-URI = scheme ":" hier-part [ "?" query ]` -/ +def absoluteURI : Re := seq [scheme, litCI ":", hierPart, opt (cat (litCI "?") query)] + +/-! ## RFC 9110, sections 4.1, 4.2 and 7.2 -/ + +/-- `absolute-path = 1*( "/" segment )` (section 4.1) -/ +def absolutePath : Re := plus (cat (litCI "/") segment) + +/-- `uri-host = ` -/ +def uriHost : Re := host + +/-- A `host` that is not empty: + `IP-literal / IPv4address / 1*( unreserved / pct-encoded / sub-delims )`. -/ +def hostNonEmpty : Re := + any [IPliteral, IPv4address, plus (any [unreserved, pctEncoded, subDelims])] + +/-- A Host value this library accepts: empty, or a host that is not empty + with an optional port, `[ hostNonEmpty [ ":" port ] ]`. -/ +def hostField : Re := opt (cat hostNonEmpty (opt (cat (litCI ":") port))) + +/-- An `http-URI` or `https-URI` (sections 4.2.1 and 4.2.2) whose host is + not empty and whose authority has no `userinfo`. -/ +def httpTarget : Re := + seq [alt (litCI "http") (litCI "https"), litCI "://", hostNonEmpty, + opt (cat (litCI ":") port), pathAbempty, opt (cat (litCI "?") query)] + +/-! ## RFC 9110, sections 5.6.1.2 and 5.6.3 -/ + +/-- `SP = %x20` -/ +def SP : Re := byte 0x20 + +/-- `HTAB = %x09 ; horizontal tab` -/ +def HTAB : Re := byte 0x09 + +/-- `OWS = *( SP / HTAB )` (section 5.6.3) -/ +def OWS : Re := star (alt SP HTAB) + +/-- A list with one element, `e`, as a recipient reads a list (section + 5.6.1.2): `*( OWS "," OWS ) element *( OWS "," OWS )`. -/ +def listOne (e : Re) : Re := + seq [star (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])] + +/-- A Transfer-Encoding value that lists the one coding `chunked`. -/ +def chunkedList : Re := listOne (litCI "chunked") + +/-! ## RFC 9112 -/ + +/-- `origin-form = absolute-path [ "?" query ]` (section 3.2.1) -/ +def originForm : Re := cat absolutePath (opt (cat (litCI "?") query)) + +/-- `absolute-form = absolute-URI` (section 3.2.2) -/ +def absoluteForm : Re := absoluteURI + +/-- `authority-form = uri-host ":" port` (section 3.2.3) -/ +def authorityForm : Re := seq [uriHost, litCI ":", port] + +/-- A CONNECT target this library accepts: `authority-form` with a host + that is not empty, `hostNonEmpty ":" port`. -/ +def connectTarget : Re := seq [hostNonEmpty, litCI ":", port] + +/-- `asterisk-form = "*"` (section 3.2.4) -/ +def asteriskForm : Re := litCI "*" + +/-- `request-target = origin-form / absolute-form / authority-form / + asterisk-form` (section 3.2) -/ +def requestTarget : Re := + any [originForm, absoluteForm, authorityForm, asteriskForm] + +end Http.Grammar diff --git a/Http/Head.lean b/Http/Head.lean new file mode 100644 index 0000000..6960bf8 --- /dev/null +++ b/Http/Head.lean @@ -0,0 +1,124 @@ +/- + Reading and writing a request head (RFC 9112, sections 2 to 5): the + request line, the field lines, and the empty line that ends them. +-/ + +import Http.Types +import Http.Match +import Http.Grammar + +namespace Http + +/-- SP or HTAB. -/ +def isWs (c : UInt8) : Bool := c == 0x20 || c == 0x09 + +/-- An ASCII digit. -/ +def isDigit (c : UInt8) : Bool := 0x30 ≤ c && c ≤ 0x39 + +/-- An ASCII letter. -/ +def isAlpha (c : UInt8) : Bool := (0x41 ≤ c && c ≤ 0x5A) || (0x61 ≤ c && c ≤ 0x7A) + +/-- A `tchar` (RFC 9110, section 5.6.2): a letter, a digit, or one of + ``!#$%&'*+-.^_`|~``. -/ +def isTchar (c : UInt8) : Bool := + isAlpha c || isDigit c || [0x21, 0x23, 0x24, 0x25, 0x26, 0x27, 0x2A, 0x2B, 0x2D, 0x2E, 0x5E, 0x5F, + 0x60, 0x7C, 0x7E].contains c + +/-- A `token`: one or more `tchar`. -/ +def isToken (s : List UInt8) : Bool := !s.isEmpty && s.all isTchar + +/-- A `field-vchar`: a visible ASCII character or an octet from 0x80. -/ +def isVchar (c : UInt8) : Bool := (0x21 ≤ c && c ≤ 0x7E) || 0x80 ≤ c + +/-- A `field-value`: visible characters, with SP and HTAB only between + them. -/ +def isFieldValue (v : List UInt8) : Bool := + v.all (fun c => isVchar c || isWs c) && + match v.head?, v.getLast? with + | some a, some b => isVchar a && isVchar b + | _, _ => true + +/-- The value without the whitespace around it. -/ +def trim (v : List UInt8) : List UInt8 := + ((v.dropWhile isWs).reverse.dropWhile isWs).reverse + +/-- `takeLine`, with the octets of the line read so far in `acc`, last + first. It calls itself last, so it runs in constant stack. -/ +def takeLineFrom (acc : List UInt8) : List UInt8 → Option (List UInt8 × List UInt8) + | [] => none + | c :: rest => + if c == 0x0D then + match rest with + | d :: rest' => if d == 0x0A then some (acc.reverse, rest') else none + | [] => none + else if c == 0x0A then none + else takeLineFrom (c :: acc) rest + +/-- The first line: the octets up to the first CR, which must be + followed by LF, and what comes after the CRLF. `none` when there is + no CR, when a LF comes first, or when the CR is not followed by LF. -/ +def takeLine (bs : List UInt8) : Option (List UInt8 × List UInt8) := takeLineFrom [] bs + +/-- The octets after any empty lines at the start. -/ +def skipEmpty : List UInt8 → List UInt8 + | c :: d :: rest => if c == 0x0D && d == 0x0A then skipEmpty rest else c :: d :: rest + | bs => bs + +/-- The version `HTTP/d.d`, as its two digits. -/ +def parseVersion : List UInt8 → Option (Nat × Nat) + | [h, t1, t2, p, s, a, dot, b] => + if h == 0x48 && t1 == 0x54 && t2 == 0x54 && p == 0x50 && s == 0x2F && dot == 0x2E && + isDigit a && isDigit b then + some (a.toNat - 0x30, b.toNat - 0x30) + else none + | _ => none + +/-- A field line: a token, a colon, and a value with optional whitespace + around it. -/ +def parseField (line : List UInt8) : Option Field := + let name := line.takeWhile (· != 0x3A) + match line.drop name.length with + | _ :: v => + let value := trim v + if isToken name && isFieldValue value then some ⟨name, value⟩ else none + | [] => none + +/-- `parseFields`, with the fields read so far in `acc`, last first. It + calls itself last, so it runs in constant stack. -/ +def parseFieldsFrom (acc : List Field) : Nat → List UInt8 → Option (List Field × List UInt8) + | 0, _ => none + | fuel + 1, bs => + match takeLine bs with + | none => none + | some (line, rest) => + if line.isEmpty then some (acc.reverse, rest) + else + match parseField line with + | none => none + | some f => parseFieldsFrom (f :: acc) fuel rest + +/-- The field lines up to the empty line, and what follows it. -/ +def parseFields (fuel : Nat) (bs : List UInt8) : Option (List Field × List UInt8) := + parseFieldsFrom [] fuel bs + +/-- Reads a request head from the start of `bs`, after any empty lines, + and gives it with the octets that follow it. -/ +def parseHead (bs : List UInt8) : Option (Head × List UInt8) := do + let (line, rest) ← takeLine (skipEmpty bs) + match line.splitOn 0x20 with + | [m, t, v] => + let (major, minor) ← parseVersion v + if isToken m && Grammar.requestTarget.isMatch t then + let (fs, rest') ← parseFields (rest.length + 1) rest + pure (⟨m, t, major, minor, fs⟩, rest') + else none + | _ => none + +/-- Writes the head: the request line, each field as `name: value`, and + the empty line, each line ending in CRLF. -/ +def Head.print (h : Head) : List UInt8 := + h.method ++ [0x20] ++ h.target ++ [0x20, 0x48, 0x54, 0x54, 0x50, 0x2F, (0x30 + h.major).toUInt8, + 0x2E, (0x30 + h.minor).toUInt8, 0x0D, 0x0A] ++ + (h.fields.map fun f => f.name ++ [0x3A, 0x20] ++ f.value ++ [0x0D, 0x0A]).flatten ++ [0x0D, 0x0A] + +end Http diff --git a/Http/Match.lean b/Http/Match.lean new file mode 100644 index 0000000..c02e3b2 --- /dev/null +++ b/Http/Match.lean @@ -0,0 +1,65 @@ +/- + Matching a string against a rule of the grammar notation, by + Brzozowski derivatives: the derivative of a rule by an octet matches + what can follow that octet. The constructors `mkCat` and `mkAlt` drop + rules that match nothing, and `mkAlt` folds two kinds of repeat: + `alt a a` is `a`, and `alt (alt x y) y` is `alt x y`. Without the + second, each SP after a comma in a Transfer-Encoding list would add a + level of `alt` to the derivative. + + Matching takes one derivative per octet. When a rule has finitely + many derivatives, each takes bounded time, so matching takes time + linear in the length of the string. Each rule the code matches, in + `Http/Grammar.lean`, has finitely many: listing all the derivatives + of each ends. That was checked by running the matcher, not proved. +-/ + +import Http.Abnf + +namespace Http.Re + +/-- Whether the rule matches the empty string. -/ +def nullable : Re → Bool + | empty => false + | eps => true + | range _ _ => false + | cat a b => a.nullable && b.nullable + | alt a b => a.nullable || b.nullable + | star _ => true + +/-- `cat`, simplified where one side matches nothing or only the empty + string. -/ +def mkCat : Re → Re → Re + | empty, _ => empty + | _, empty => empty + | eps, b => b + | a, eps => a + | a, b => cat a b + +/-- `alt`, simplified where one side matches nothing, where both are the + same, or where the right one is already the right one of the left. -/ +def mkAlt : Re → Re → Re + | empty, b => b + | a, empty => a + | a, b => + if a = b then a + else match a with + | alt _ y => if y = b then a else alt a b + | _ => alt a b + +/-- What can follow the octet `c` in a string the rule matches. -/ +def deriv (c : UInt8) : Re → Re + | empty => empty + | eps => empty + | range lo hi => if lo ≤ c ∧ c ≤ hi then eps else empty + | cat a b => + if a.nullable then mkAlt (mkCat (deriv c a) b) (deriv c b) else mkCat (deriv c a) b + | alt a b => mkAlt (deriv c a) (deriv c b) + | star a => mkCat (deriv c a) (star a) + +/-- Whether the rule matches the string. -/ +def isMatch (r : Re) : List UInt8 → Bool + | [] => r.nullable + | c :: cs => (r.deriv c).isMatch cs + +end Http.Re diff --git a/Http/Types.lean b/Http/Types.lean new file mode 100644 index 0000000..974767e --- /dev/null +++ b/Http/Types.lean @@ -0,0 +1,34 @@ +/- + What a request head is, and how its body is framed. Part of the + approved specification, with `Spec.lean`, since the statements are + about these types. +-/ + +namespace Http + +/-- A field line: its name and its value, as octets, the value without + the optional whitespace around it. -/ +structure Field where + name : List UInt8 + value : List UInt8 + deriving DecidableEq, Repr + +/-- A request head: the request line, `method SP request-target SP + HTTP-version`, with the version's two digits as numbers, and the + field lines in order. -/ +structure Head where + method : List UInt8 + target : List UInt8 + major : Nat + minor : Nat + fields : List Field + deriving DecidableEq, Repr + +/-- How the body after a head is delimited: by a length in octets, which + is 0 when there is no body, or by the chunked transfer coding. -/ +inductive Framing where + | length (n : Nat) + | chunked + deriving DecidableEq, Repr + +end Http diff --git a/Main.lean b/Main.lean new file mode 100644 index 0000000..613a9ac --- /dev/null +++ b/Main.lean @@ -0,0 +1,137 @@ +/- + Command line front end. + + httphead check + + reads a request from standard input and prints its head, one line for + the request line and one for each field, then how its body is framed: + `length N`, `chunked`, or `reject` when this library refuses it. It + prints `invalid` when the input does not start with a request head of + the grammar. It exits with 0 for a framed request and 1 otherwise. + + httphead serve + + answers requests on standard input, one per line, for the + differential tests. Octets are sent as lower-case hex digits. + + head HEX prints OK, then tab-separated: the head as + `Head.print` writes it, in hex, the octets after + the head, in hex, and the framing (`length N`, + `chunked` or `reject`); or REJECT + + A malformed request prints `error`: an unknown operation, or hex + digits that are not lower case or not in pairs. A request line may end + in LF or CR LF. + + Every answer comes from the proved functions in `Http/`: `parseHead`, + `Head.print` and `Head.framing`. The hex coding and the request + handling here are covered by the tests, not by a proof. +-/ + +import Http + +open Http + +def hexValue (c : Char) : Option Nat := + if '0' ≤ c ∧ c ≤ '9' then some (c.toNat - '0'.toNat) + else if 'a' ≤ c ∧ c ≤ 'f' then some (c.toNat - 'a'.toNat + 10) + else none + +/-- The octets that pairs of hex digits write, with the octets so far in + `acc`, last first. It calls itself last, so it runs in constant + stack. -/ +def hexBytesFrom (acc : List UInt8) : List Char → Option (List UInt8) + | [] => some acc.reverse + | a :: b :: rest => + match hexValue a, hexValue b with + | some hi, some lo => hexBytesFrom ((hi * 16 + lo).toUInt8 :: acc) rest + | _, _ => none + | [_] => none + +def hexBytes (cs : List Char) : Option (List UInt8) := hexBytesFrom [] cs + +def hexDigit (n : Nat) : Char := "0123456789abcdef".toList.getD n '0' + +def toHex (bs : List UInt8) : String := + String.ofList (bs.flatMap fun b => [hexDigit (b.toNat / 16), hexDigit (b.toNat % 16)]) + +/-- `s` with zeros in front, to make at least `width` characters. -/ +def padZeros (s : String) (width : Nat) : String := + String.ofList (List.replicate (width - s.length) '0') ++ s + +/-- The decimal digits of `n`, with zeros in front to make at least + `width` digits, as `toString` writes them. `toString` finds one digit + at a time, so for a number of many digits it takes time that grows + with the square of their number. From 2^64 on, `n` is split instead + into its high and low digits, by dividing by a power of 10, and each + part is written the same way, for at most `fuel` levels. -/ +def decimalText : Nat → Nat → Nat → String + | 0, n, width => padZeros (toString n) width + | fuel + 1, n, width => + if n < 2 ^ 64 then padZeros (toString n) width + else + -- `n.log2 * 3 / 10 + 1` is at most the number of digits of `n`, so + -- the high part is not 0 + let k := (n.log2 * 3 / 10 + 1) / 2 + let p := 10 ^ k + decimalText fuel (n / p) (width - k) ++ decimalText fuel (n % p) k + +def framingText : Option Framing → String + | some (.length n) => "length " ++ decimalText 64 n 0 + | some .chunked => "chunked" + | none => "reject" + +/-- The answer to one request line, or `none` when it is malformed. -/ +def request (line : String) : Option String := + match line.splitOn " " with + | ["head", h] => do + let bs ← hexBytes h.toList + pure <| match parseHead bs with + | some (hd, rest) => s!"OK\t{toHex hd.print}\t{toHex rest}\t{framingText hd.framing}" + | none => "REJECT" + | _ => 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 serve : IO Unit := do + let stdin ← IO.getStdin + let stdout ← IO.getStdout + repeat + let line ← stdin.getLine + if line.isEmpty then break + stdout.putStrLn ((request (chomp line)).getD "error") + +/-- Octets as text, with each octet outside printable ASCII as `\xHH`. -/ +def escape (bs : List UInt8) : String := + String.join (bs.map fun b => + if 0x20 ≤ b ∧ b < 0x7F ∧ b ≠ 0x5C then (Char.ofNat b.toNat).toString + else "\\x" ++ String.ofList [hexDigit (b.toNat / 16), hexDigit (b.toNat % 16)]) + +def check : IO UInt32 := do + let stdin ← IO.getStdin + let input ← stdin.readBinToEnd + match parseHead input.toList with + | some (h, _) => + IO.println s!"{escape h.method} {escape h.target} HTTP/{h.major}.{h.minor}" + for f in h.fields do + IO.println s!"{escape f.name}: {escape f.value}" + let fr := h.framing + IO.println (framingText fr) + return if fr.isSome then 0 else 1 + | none => + IO.println "invalid" + return 1 + +def usage : String := "usage: httphead check < request\n httphead serve" + +def main (args : List String) : IO UInt32 := do + match args with + | ["check"] => check + | ["serve"] => serve; return 0 + | _ => IO.eprintln usage; return 2 diff --git a/Proofs.lean b/Proofs.lean new file mode 100644 index 0000000..6a6e36c --- /dev/null +++ b/Proofs.lean @@ -0,0 +1 @@ +import Proofs.Main diff --git a/Proofs/Fields.lean b/Proofs/Fields.lean new file mode 100644 index 0000000..082ed5a --- /dev/null +++ b/Proofs/Fields.lean @@ -0,0 +1,550 @@ +/- + Tokens, field values, optional whitespace, and the field lines. +-/ + +import Http.Head +import Spec.Defs +import Proofs.Lines + +namespace Http.Proofs.Fields + +open Http Http.Re + +private theorem m_eps {s : List UInt8} : Spec.Matches .eps s ↔ s = [] := by + constructor + · intro h; cases h; rfl + · rintro rfl; exact .eps + +private theorem m_range {lo hi : UInt8} {s : List UInt8} : + Spec.Matches (.range lo hi) s ↔ ∃ c, s = [c] ∧ lo ≤ c ∧ c ≤ hi := by + constructor + · intro h; cases h with + | range h1 h2 => exact ⟨_, rfl, h1, h2⟩ + · rintro ⟨c, rfl, h1, h2⟩; exact .range h1 h2 + +private theorem m_cat {a b : Re} {s : List UInt8} : + Spec.Matches (.cat a b) s ↔ ∃ s1 s2, s = s1 ++ s2 ∧ Spec.Matches a s1 ∧ Spec.Matches b s2 := by + constructor + · intro h; cases h with + | cat h1 h2 => exact ⟨_, _, rfl, h1, h2⟩ + · rintro ⟨s1, s2, rfl, h1, h2⟩; exact .cat h1 h2 + +private theorem m_alt {a b : Re} {s : List UInt8} : + Spec.Matches (.alt a b) s ↔ Spec.Matches a s ∨ Spec.Matches b s := by + constructor + · intro h; cases h with + | altL h => exact .inl h + | altR h => exact .inr h + · rintro (h | h) + · exact .altL h + · exact .altR h + +/-- Induction principle for star. -/ +private theorem star_ind {a : Re} (P : List UInt8 → Prop) (h0 : P []) + (h1 : ∀ s t, Spec.Matches a s → Spec.Matches (.star a) t → P t → P (s ++ t)) + {s : List UInt8} (h : Spec.Matches (.star a) s) : P s := by + generalize e : Re.star a = R at h + induction h with + | eps => cases e + | range => cases e + | cat => cases e + | altL => cases e + | altR => cases e + | starNil => exact h0 + | starCons hs ht _ iht => + cases e + exact h1 _ _ hs ht (iht rfl) + +/-- `r` matches exactly the one-octet strings `[x]` with `p x`. -/ +private def Single (r : Re) (p : UInt8 → Bool) : Prop := + ∀ s, Spec.Matches r s ↔ ∃ x, s = [x] ∧ p x = true + +private theorem single_range (lo hi : UInt8) : Single (.range lo hi) (fun x => decide (lo ≤ x) && decide (x ≤ hi)) := by + intro s; rw [m_range]; simp + +private theorem single_alt {a b : Re} {p q : UInt8 → Bool} (ha : Single a p) (hb : Single b q) : + Single (.alt a b) (fun x => p x || q x) := by + intro s; rw [m_alt, ha, hb] + constructor + · rintro (⟨x, rfl, hx⟩ | ⟨x, rfl, hx⟩) <;> exact ⟨x, rfl, by simp [hx]⟩ + · rintro ⟨x, rfl, hx⟩ + simp only [Bool.or_eq_true] at hx + rcases hx with hx | hx + · exact .inl ⟨x, rfl, hx⟩ + · exact .inr ⟨x, rfl, hx⟩ + +private theorem single_congr {r : Re} {p q : UInt8 → Bool} (h : Single r p) (hpq : ∀ x, p x = q x) : + Single r q := by + intro s; rw [h]; simp [hpq] + +private theorem single_star {r : Re} {p : UInt8 → Bool} (h : Single r p) (s : List UInt8) : + Spec.Matches (.star r) s ↔ ∀ x ∈ s, p x = true := by + constructor + · intro hs + refine star_ind (fun s => ∀ x ∈ s, p x = true) (by simp) ?_ hs + intro s t hs _ ht + obtain ⟨y, rfl, hy⟩ := (h s).1 hs + intro x hx + simp at hx + rcases hx with rfl | hx + · exact hy + · exact ht x hx + · intro hs + induction s with + | nil => exact .starNil + | cons y s ih => + have : y :: s = [y] ++ s := rfl + rw [this] + exact .starCons ((h _).2 ⟨y, rfl, hs y (by simp)⟩) (ih (fun x hx => hs x (by simp [hx]))) + +private theorem single_plus {r : Re} {p : UInt8 → Bool} (h : Single r p) (s : List UInt8) : + Spec.Matches (plus r) s ↔ s ≠ [] ∧ ∀ x ∈ s, p x = true := by + simp only [plus] + rw [m_cat] + constructor + · rintro ⟨s1, s2, rfl, h1, h2⟩ + obtain ⟨y, rfl, hy⟩ := (h _).1 h1 + rw [single_star h] at h2 + refine ⟨by simp, ?_⟩ + intro x hx + simp at hx + rcases hx with rfl | hx + · exact hy + · exact h2 x hx + · rintro ⟨hne, hs⟩ + match s, hne with + | y :: s', _ => + refine ⟨[y], s', rfl, (h _).2 ⟨y, rfl, hs y (by simp)⟩, ?_⟩ + rw [single_star h] + intro x hx; exact hs x (by simp [hx]) + + +private theorem uint8_forall {p : UInt8 → Prop} (h : ∀ n, n < 256 → p (UInt8.ofNat n)) : ∀ x, p x := by + intro x + have := h x.toNat (UInt8.toNat_lt x) + rwa [UInt8.ofNat_toNat] at this + +/-- Whether a rule is a class of single octets. -/ +private def IsCls : Re → Bool + | .range _ _ => true + | .alt a b => IsCls a && IsCls b + | _ => false + +/-- The octets of a class. -/ +private def clsP : Re → UInt8 → Bool + | .range lo hi => fun x => decide (lo ≤ x) && decide (x ≤ hi) + | .alt a b => fun x => clsP a x || clsP b x + | _ => fun _ => false + +private theorem cls_single : ∀ (r : Re), IsCls r = true → Single r (clsP r) + | .range lo hi, _ => single_range lo hi + | .alt a b, h => by + simp only [IsCls, Bool.and_eq_true] at h + exact single_alt (cls_single a h.1) (cls_single b h.2) + | .empty, h => by simp [IsCls] at h + | .eps, h => by simp [IsCls] at h + | .cat _ _, h => by simp [IsCls] at h + | .star _, h => by simp [IsCls] at h + +private theorem tchar_eq : Spec.tchar = any [byte 0x21, byte 0x23, byte 0x24, byte 0x25, byte 0x26, byte 0x27, + byte 0x2A, byte 0x2B, byte 0x2D, byte 0x2E, byte 0x5E, byte 0x5F, + byte 0x60, byte 0x7C, byte 0x7E, Spec.DIGIT, Spec.ALPHA] := by decide + +private theorem single_tchar : Single Spec.tchar isTchar := by + rw [tchar_eq] + refine single_congr (cls_single _ rfl) ?_ + exact uint8_forall (by decide +kernel) + +private theorem single_ws : Single (.alt Spec.SP Spec.HTAB) isWs := + single_congr (cls_single _ rfl) (uint8_forall (by decide +kernel)) + +private theorem single_digit : Single Spec.DIGIT isDigit := + single_congr (cls_single _ rfl) (uint8_forall (by decide +kernel)) + +private theorem single_fieldVchar : Single Spec.fieldVchar isVchar := + single_congr (cls_single _ rfl) (uint8_forall (by decide +kernel)) + +private theorem single_wsv : Single (any [Spec.SP, Spec.HTAB, Spec.fieldVchar]) (fun x => isWs x || isVchar x) := + single_congr (cls_single _ rfl) (uint8_forall (by decide +kernel)) + + +theorem isToken_iff (s : List UInt8) : isToken s = true ↔ Spec.Matches Spec.token s := by + rw [Spec.token, single_plus single_tchar] + simp [isToken, List.all_eq_true] + +theorem OWS_iff (w : List UInt8) : Spec.Matches Spec.OWS w ↔ ∀ c ∈ w, isWs c = true := by + rw [Spec.OWS, single_star single_ws] + +theorem contentLength_iff (v : List UInt8) : + Spec.Matches Spec.contentLength v ↔ v ≠ [] ∧ ∀ c ∈ v, isDigit c = true := by + rw [Spec.contentLength, single_plus single_digit] + +theorem port_iff (v : List UInt8) : Spec.Matches Spec.port v ↔ ∀ c ∈ v, isDigit c = true := by + rw [Spec.port, single_star single_digit] + +/-- The shape of a field value. -/ +private def FV (v : List UInt8) : Prop := + (∀ x ∈ v, (isVchar x || isWs x) = true) ∧ (∀ a, v.head? = some a → isVchar a = true) ∧ + (∀ b, v.getLast? = some b → isVchar b = true) + +private theorem FV_append {s t : List UInt8} (hs : FV s) (ht : FV t) : FV (s ++ t) := by + obtain ⟨hs1, hs2, hs3⟩ := hs + obtain ⟨ht1, ht2, ht3⟩ := ht + refine ⟨?_, ?_, ?_⟩ + · intro x hx + rw [List.mem_append] at hx + rcases hx with hx | hx + · exact hs1 x hx + · exact ht1 x hx + · intro a ha + rw [List.head?_append] at ha + cases h : s.head? with + | some a' => rw [h] at ha; simp at ha; subst ha; exact hs2 _ h + | none => rw [h] at ha; simp at ha; exact ht2 _ ha + · intro b hb + rw [List.getLast?_append] at hb + cases h : t.getLast? with + | some b' => rw [h] at hb; simp at hb; subst hb; exact ht3 _ h + | none => rw [h] at hb; simp at hb; exact hs3 _ hb + +private theorem fc_iff (s : List UInt8) : Spec.Matches Spec.fieldContent s ↔ + ∃ a rest, s = a :: rest ∧ isVchar a = true ∧ + (rest = [] ∨ ∃ m b, rest = m ++ [b] ∧ m ≠ [] ∧ (∀ x ∈ m, (isWs x || isVchar x) = true) ∧ + isVchar b = true) := by + have hv : ∀ s, Spec.Matches Spec.fieldVchar s ↔ ∃ x, s = [x] ∧ isVchar x = true := + single_fieldVchar + rw [Spec.fieldContent, m_cat] + simp only [opt, m_alt, m_eps, m_cat, single_plus single_wsv, hv] + constructor + · rintro ⟨s1, s2, rfl, ⟨a, rfl, ha⟩, h2⟩ + refine ⟨a, s2, rfl, ha, ?_⟩ + rcases h2 with h2 | ⟨m, s3, rfl, ⟨hm1, hm2⟩, ⟨b, rfl, hb⟩⟩ + · exact .inl h2 + · exact .inr ⟨m, b, rfl, hm1, hm2, hb⟩ + · rintro ⟨a, rest, rfl, ha, h⟩ + refine ⟨[a], rest, rfl, ⟨a, rfl, ha⟩, ?_⟩ + rcases h with h | ⟨m, b, rfl, hm1, hm2, hb⟩ + · exact .inl h + · exact .inr ⟨m, [b], rfl, ⟨hm1, hm2⟩, ⟨b, rfl, hb⟩⟩ + +private theorem fc_FV {s : List UInt8} (h : Spec.Matches Spec.fieldContent s) : FV s := by + rw [fc_iff] at h + obtain ⟨a, rest, rfl, ha, h⟩ := h + rcases h with rfl | ⟨m, b, rfl, _, hm2, hb⟩ + · refine ⟨?_, ?_, ?_⟩ + · intro x hx; simp at hx; subst hx; simp [ha] + · intro a' h'; simp at h'; subst h'; exact ha + · intro a' h'; simp at h'; subst h'; exact ha + · refine ⟨?_, ?_, ?_⟩ + · intro x hx + simp only [List.mem_cons, List.mem_append, List.not_mem_nil, or_false] at hx + rcases hx with rfl | hx | rfl + · simp [ha] + · have := hm2 x hx; simp only [Bool.or_eq_true] at this ⊢; exact this.symm + · simp [hb] + · intro a' h'; simp at h'; subst h'; exact ha + · intro b' h' + have : (a :: (m ++ [b])).getLast? = some b := by + rw [← List.cons_append, List.getLast?_append]; simp + rw [this] at h'; simp at h'; subst h'; exact hb + +private theorem isFieldValue_FV (v : List UInt8) : isFieldValue v = true ↔ FV v := by + unfold isFieldValue FV + cases v with + | nil => simp + | cons a rest => + have hl : (a :: rest).getLast? = some ((a :: rest).getLast (by simp)) := List.getLast?_eq_some_getLast _ + rw [hl] + simp only [List.head?_cons, Bool.and_eq_true, List.all_eq_true] + constructor + · rintro ⟨h1, h2, h3⟩ + refine ⟨h1, ?_, ?_⟩ + · intro a' h; simp at h; subst h; exact h2 + · intro b' h; simp at h; subst h; exact h3 + · rintro ⟨h1, h2, h3⟩ + exact ⟨h1, h2 _ rfl, h3 _ rfl⟩ + +theorem isFieldValue_iff (v : List UInt8) : + isFieldValue v = true ↔ Spec.Matches Spec.fieldValue v := by + rw [isFieldValue_FV, Spec.fieldValue] + constructor + · rintro ⟨h1, h2, h3⟩ + have fc1 : ∀ a, isVchar a = true → Spec.Matches Spec.fieldContent [a] := by + intro a ha; rw [fc_iff]; exact ⟨a, [], rfl, ha, .inl rfl⟩ + match v, h1, h2, h3 with + | [], _, _, _ => exact .starNil + | a :: rest, h1, h2, h3 => + have ha : isVchar a = true := h2 a rfl + rcases List.eq_nil_or_concat rest with rfl | ⟨m, b, rfl⟩ + all_goals try simp only [List.concat_eq_append] at * + · have : [a] = [a] ++ [] := rfl + rw [this]; exact .starCons (fc1 a ha) .starNil + · have hb : isVchar b = true := by + apply h3; rw [← List.cons_append, List.getLast?_append]; simp + cases m with + | nil => + have : a :: ([] ++ [b]) = [a] ++ ([b] ++ []) := rfl + rw [this]; exact .starCons (fc1 a ha) (.starCons (fc1 b hb) .starNil) + | cons c m' => + have : a :: ((c :: m') ++ [b]) = (a :: ((c :: m') ++ [b])) ++ [] := by simp + rw [this] + refine .starCons ?_ .starNil + rw [fc_iff] + refine ⟨a, _, rfl, ha, .inr ⟨c :: m', b, rfl, by simp, ?_, hb⟩⟩ + intro x hx + have := h1 x (List.mem_cons_of_mem _ (List.mem_append_left _ hx)) + simp only [Bool.or_eq_true] at this ⊢; exact this.symm + · intro h + refine star_ind FV ⟨by simp, by simp, by simp⟩ ?_ h + intro s t hs _ ht + exact FV_append (fc_FV hs) ht + + +private theorem mem_takeWhile {p : UInt8 → Bool} : ∀ {l : List UInt8} {x : UInt8}, x ∈ l.takeWhile p → p x = true + | [], _, h => by simp at h + | a :: l, x, h => by + rw [List.takeWhile_cons] at h + split at h + · simp only [List.mem_cons] at h + rcases h with rfl | h + · assumption + · exact mem_takeWhile h + · simp at h + +private theorem drop_takeWhile (p : UInt8 → Bool) : ∀ l : List UInt8, l.drop (l.takeWhile p).length = l.dropWhile p + | [] => rfl + | a :: l => by + rw [List.takeWhile_cons, List.dropWhile_cons] + split + · simp only [List.length_cons, List.drop_succ_cons]; exact drop_takeWhile p l + · rfl + +private theorem dropWhile_head {p : UInt8 → Bool} : ∀ {l v : List UInt8} {c : UInt8}, + l.dropWhile p = c :: v → p c = false + | [], _, _, h => by simp at h + | a :: l, v, c, h => by + rw [List.dropWhile_cons] at h + split at h + · exact dropWhile_head h + · rename_i hn; simp at h; obtain ⟨rfl, rfl⟩ := h; simpa using hn + +private theorem takeWhile_prefix {p : UInt8 → Bool} : ∀ {xs : List UInt8} (y : UInt8) (ys : List UInt8), + (∀ x ∈ xs, p x = true) → p y = false → (xs ++ y :: ys).takeWhile p = xs + | [], y, ys, _, hy => by simp [hy] + | a :: xs, y, ys, h, hy => by + rw [List.cons_append, List.takeWhile_cons, ite_eq_left (h a (by simp)), + takeWhile_prefix y ys (fun x hx => h x (by simp [hx])) hy] + +private theorem dropWhile_ws {p : UInt8 → Bool} {xs ys : List UInt8} (h1 : ∀ x ∈ xs, p x = true) + (h2 : ∀ y, ys.head? = some y → p y = false) : (xs ++ ys).dropWhile p = ys := by + rw [List.dropWhile_append_of_pos h1] + cases ys with + | nil => rfl + | cons y ys => rw [List.dropWhile_cons_of_neg (by simp [h2 y rfl])] + +private theorem trim_split (v : List UInt8) : ∃ w1 w2, (∀ c ∈ w1, isWs c = true) ∧ (∀ c ∈ w2, isWs c = true) ∧ + v = w1 ++ trim v ++ w2 := by + refine ⟨v.takeWhile isWs, ((v.dropWhile isWs).reverse.takeWhile isWs).reverse, + fun c hc => mem_takeWhile hc, fun c hc => mem_takeWhile (List.mem_reverse.1 hc), ?_⟩ + unfold trim + rw [List.append_assoc, ← List.reverse_append, List.takeWhile_append_dropWhile, List.reverse_reverse, + List.takeWhile_append_dropWhile] + +private theorem vchar_not_ws : ∀ x, isVchar x = true → isWs x = false := + uint8_forall (by decide +kernel) + +private theorem trim_eq {w1 w2 val : List UInt8} (h1 : ∀ c ∈ w1, isWs c = true) (h2 : ∀ c ∈ w2, isWs c = true) + (hv : FV val) : trim (w1 ++ val ++ w2) = val := by + unfold trim + cases val with + | nil => + have e : w1 ++ [] ++ w2 = (w1 ++ w2) ++ [] := by simp + rw [e, List.dropWhile_append_of_pos (fun x hx => by + rw [List.mem_append] at hx; rcases hx with hx | hx; exact h1 x hx; exact h2 x hx)] + rfl + | cons a rest => + obtain ⟨_, hv2, hv3⟩ := hv + rw [List.append_assoc, dropWhile_ws h1, List.reverse_append, dropWhile_ws, List.reverse_reverse] + · intro c hc; exact h2 c (List.mem_reverse.1 hc) + · intro y hy; rw [List.head?_reverse] at hy; exact vchar_not_ws y (hv3 y hy) + · intro y hy; simp at hy; subst hy; exact vchar_not_ws _ (hv2 _ rfl) + +private theorem tchar_not_colon : ∀ x, isTchar x = true → (x != 0x3A) = true := + uint8_forall (by decide +kernel) + +private theorem token_tchar {s : List UInt8} (h : Spec.Matches Spec.token s) : ∀ x ∈ s, isTchar x = true := + ((single_plus single_tchar s).1 h).2 + +theorem parseField_iff (line : List UInt8) (f : Field) : + parseField line = some f ↔ Spec.FieldValid f ∧ Spec.FieldLineText f line := by + constructor + · intro hp + unfold parseField at hp + dsimp only at hp + rw [drop_takeWhile] at hp + split at hp + · rename_i c v heq + split at hp + · rename_i hc + cases hp + simp only [Bool.and_eq_true] at hc + refine ⟨⟨(isToken_iff _).1 hc.1, (isFieldValue_iff _).1 hc.2⟩, ?_⟩ + obtain ⟨w1, w2, hw1, hw2, hvw⟩ := trim_split v + refine ⟨w1, w2, (OWS_iff _).2 hw1, (OWS_iff _).2 hw2, ?_⟩ + have hc3 : c = 0x3A := by + have := dropWhile_head heq; simpa using this + subst hc3 + conv => lhs; rw [← List.takeWhile_append_dropWhile (p := (· != 0x3A)) (l := line)] + rw [heq] + conv => lhs; rw [hvw] + simp + · cases hp + · cases hp + · rintro ⟨⟨hn, hv⟩, w1, w2, h1, h2, rfl⟩ + rw [OWS_iff] at h1 h2 + have hfv : FV f.value := (isFieldValue_FV _).1 ((isFieldValue_iff _).2 hv) + have e : f.name ++ [0x3A] ++ w1 ++ f.value ++ w2 = f.name ++ 0x3A :: (w1 ++ f.value ++ w2) := by + simp + rw [e] + have ht : (f.name ++ 0x3A :: (w1 ++ f.value ++ w2)).takeWhile (· != 0x3A) = f.name := + takeWhile_prefix _ _ (fun x hx => tchar_not_colon x (token_tchar hn x hx)) (by decide) + unfold parseField + simp only [ht, List.drop_left, trim_eq h1 h2 hfv] + rw [(isToken_iff _).2 hn, (isFieldValue_iff _).2 hv] + rfl + + +private theorem takeLine_eq {bs l r : List UInt8} (h : takeLine bs = some (l, r)) : + bs = l ++ Spec.crlf ++ r := + ((Lines.takeLine_iff bs l r).1 h).2 + +private theorem takeLine_app {l : List UInt8} (r : List UInt8) (h : ∀ x ∈ l, x ≠ 0x0D ∧ x ≠ 0x0A) : + takeLine (l ++ Spec.crlf ++ r) = some (l, r) := + (Lines.takeLine_iff _ l r).2 ⟨⟨fun hx => (h _ hx).1 rfl, fun hx => (h _ hx).2 rfl⟩, rfl⟩ + +private theorem parseFieldsFrom_eq (acc : List Field) (fuel : Nat) (bs : List UInt8) : + parseFieldsFrom acc fuel bs = (parseFields fuel bs).map fun q => (acc.reverse ++ q.1, q.2) := by + unfold parseFields + induction fuel generalizing acc bs with + | zero => rfl + | succ fuel ih => + simp only [parseFieldsFrom] + split + · rfl + · split + · simp + · split + · rfl + · rw [ih, ih [_], Option.map_map] + congr 1 + funext q + simp + +/-- `parseFields` as a recursion on the field lines, one at a time. -/ +private theorem parseFields_step (fuel : Nat) (bs : List UInt8) : parseFields (fuel+1) bs = + (takeLine bs).bind (fun p => if p.1.isEmpty then some ([], p.2) else + (parseField p.1).bind (fun f => (parseFields fuel p.2).bind (fun q => some (f :: q.1, q.2)))) := by + conv => lhs; unfold parseFields + simp only [parseFieldsFrom] + cases takeLine bs with + | none => rfl + | some p => + obtain ⟨line, rest⟩ := p + simp only [Option.bind_some] + split + · simp + · cases hf : parseField line with + | none => simp + | some f => + simp only [Option.bind_some] + rw [parseFieldsFrom_eq] + cases parseFields fuel rest <;> simp + +private theorem tchar_line : ∀ x, isTchar x = true → x ≠ 0x0D ∧ x ≠ 0x0A := + uint8_forall (by decide +kernel) + +private theorem ws_line : ∀ x, isWs x = true → x ≠ 0x0D ∧ x ≠ 0x0A := + uint8_forall (by decide +kernel) + +private theorem vchar_line : ∀ x, (isVchar x || isWs x) = true → x ≠ 0x0D ∧ x ≠ 0x0A := + uint8_forall (by decide +kernel) + +private theorem fieldLine_octets {f : Field} {l : List UInt8} (hv : Spec.FieldValid f) + (hl : Spec.FieldLineText f l) : ∀ x ∈ l, x ≠ 0x0D ∧ x ≠ 0x0A := by + obtain ⟨hn, hval⟩ := hv + obtain ⟨w1, w2, h1, h2, rfl⟩ := hl + rw [OWS_iff] at h1 h2 + have hfv := ((isFieldValue_FV _).1 ((isFieldValue_iff _).2 hval)).1 + intro x hx + simp only [List.mem_append, List.mem_singleton] at hx + rcases hx with (((hx | rfl) | hx) | hx) | hx + · exact tchar_line x (token_tchar hn x hx) + · decide + · exact ws_line x (h1 x hx) + · exact vchar_line x (hfv x hx) + · exact ws_line x (h2 x hx) + +theorem parseFields_iff (fuel : Nat) (bs : List UInt8) (fs : List Field) (r : List UInt8) + (hfuel : bs.length < fuel) : + parseFields fuel bs = some (fs, r) ↔ + (∀ f ∈ fs, Spec.FieldValid f) ∧ ∃ t, Spec.FieldsText fs t ∧ bs = t ++ r := by + induction fuel generalizing bs fs r with + | zero => omega + | succ fuel ih => + rw [parseFields_step] + constructor + · intro h + rw [Option.bind_eq_some_iff] at h + obtain ⟨⟨line, rest⟩, hl, h⟩ := h + have hbs := takeLine_eq hl + simp only at h + split at h + · rename_i he + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rw [List.isEmpty_iff] at he + subst he + exact ⟨by simp, Spec.crlf, rfl, hbs⟩ + · rename_i he + rw [Option.bind_eq_some_iff] at h + obtain ⟨f, hf, h⟩ := h + rw [Option.bind_eq_some_iff] at h + obtain ⟨⟨fs', rest'⟩, hfs, h⟩ := h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + have hlen : rest.length < fuel := by + rw [hbs] at hfuel; simp [Spec.crlf] at hfuel; omega + obtain ⟨hv, t', ht', hrest⟩ := (ih rest fs' rest' hlen).1 hfs + obtain ⟨hfv, hft⟩ := (parseField_iff line f).1 hf + refine ⟨?_, line ++ Spec.crlf ++ t', ⟨line, t', hft, ht', rfl⟩, ?_⟩ + · intro g hg + simp only [List.mem_cons] at hg + rcases hg with rfl | hg + · exact hfv + · exact hv g hg + · rw [hbs, hrest]; simp + · rintro ⟨hv, t, ht, rfl⟩ + cases fs with + | nil => + simp only [Spec.FieldsText] at ht + subst ht + have : takeLine (Spec.crlf ++ r) = some ([], r) := takeLine_app (l := []) r (by simp) + rw [this] + rfl + | cons f fs' => + obtain ⟨l, t', hl, ht', rfl⟩ := ht + have hfv : Spec.FieldValid f := hv f (by simp) + have hoct := fieldLine_octets hfv hl + have e : l ++ Spec.crlf ++ t' ++ r = l ++ Spec.crlf ++ (t' ++ r) := by simp + rw [e, takeLine_app _ hoct] + have hne : l.isEmpty = false := by + obtain ⟨w1, w2, _, _, rfl⟩ := hl + simp + have hlen : (t' ++ r).length < fuel := by + rw [e] at hfuel; simp [Spec.crlf] at hfuel ⊢; omega + have hp : parseField l = some f := (parseField_iff l f).2 ⟨hfv, hl⟩ + have hfs : parseFields fuel (t' ++ r) = some (fs', r) := + (ih (t' ++ r) fs' r hlen).2 ⟨fun g hg => hv g (by simp [hg]), t', ht', rfl⟩ + simp only [Option.bind_some, hne, Bool.false_eq_true, ↓reduceIte, hp, hfs] + +end Http.Proofs.Fields diff --git a/Proofs/Framing.lean b/Proofs/Framing.lean new file mode 100644 index 0000000..c365d8b --- /dev/null +++ b/Proofs/Framing.lean @@ -0,0 +1,343 @@ +/- + Acceptance and framing: `framing` decides `Spec.Accepts`. +-/ + +import Http.Framing +import Spec.Defs +import Proofs.Match +import Proofs.Fields + +namespace Http.Proofs.Framing + +open Http + +private theorem lower_eq : lower = Spec.lower := by + funext c + unfold lower Spec.lower + by_cases h1 : (0x41 : UInt8) ≤ c <;> by_cases h2 : c ≤ (0x5A : UInt8) <;> simp [h1, h2] + +private theorem isNamed_iff (f : Field) (n : List UInt8) : f.isNamed n = true ↔ f.name.map Spec.lower = n := by + unfold Field.isNamed; rw [lower_eq]; simp + +private theorem named_eq (h : Head) (s : String) : + Spec.named h s = h.fields.filter (·.isNamed (Spec.ascii s)) := by + unfold Spec.named + apply List.filter_congr + intro f _ + rw [Bool.eq_iff_iff, isNamed_iff] + simp + +private theorem decimal_eq : decimal = Spec.decimal := rfl + +private theorem foldl_digits (b : List UInt8) (x : Nat) : + b.foldl (fun n d => 10 * n + (d.toNat - 0x30)) x = + x * 10 ^ b.length + b.foldl (fun n d => 10 * n + (d.toNat - 0x30)) 0 := by + induction b generalizing x with + | nil => simp + | cons d b ih => + simp only [List.foldl_cons, List.length_cons] + rw [ih, ih (10 * 0 + _), Nat.pow_succ] + simp only [Nat.mul_zero, Nat.zero_add, Nat.add_mul, Nat.mul_assoc, Nat.add_assoc] + have e : 10 * (x * 10 ^ b.length) = x * (10 ^ b.length * 10) := by + rw [Nat.mul_left_comm, Nat.mul_comm 10] + rw [e] + +/-- The number that `a ++ b` writes. -/ +private theorem decimal_append (a b : List UInt8) : + decimal (a ++ b) = decimal a * 10 ^ b.length + decimal b := by + unfold decimal + rw [List.foldl_append, foldl_digits] + +private theorem decimalBy_eq (fuel n : Nat) (ds : List UInt8) (hn : ds.length = n) : + decimalBy fuel n ds = decimal ds := by + induction fuel generalizing n ds with + | zero => rfl + | succ fuel ih => + simp only [decimalBy, List.splitAt_eq] + split + · rfl + · rw [ih (n / 2) _ (by simp [hn]; omega), ih (n - n / 2) _ (by simp [hn])] + conv => rhs; rw [← List.take_append_drop (n / 2) ds] + rw [decimal_append, List.length_drop, hn] + +private theorem decimalFast_eq : decimalFast = Spec.decimal := by + funext ds + exact decimalBy_eq _ _ _ rfl + +private theorem decimal_zero_cons (cs : List UInt8) : decimal (0x30 :: cs) = decimal cs := by + simp [decimal] + +/-- What is left of a string of digits after its leading zeros writes the + same number, and is empty or starts with a digit other than 0. -/ +private theorem dropZeros (ds : List UInt8) (hd : ∀ c ∈ ds, isDigit c = true) : + decimal (ds.dropWhile (· == 0x30)) = decimal ds ∧ (∀ c ∈ ds.dropWhile (· == 0x30), isDigit c = true) ∧ + ∀ d rest, ds.dropWhile (· == 0x30) = d :: rest → d ≠ 0x30 := by + induction ds with + | nil => simp + | cons c cs ih => + have hcs : ∀ x ∈ cs, isDigit x = true := fun x hx => hd x (by simp [hx]) + by_cases hc : c = 0x30 + · subst hc + have e : (0x30 :: cs).dropWhile (· == (0x30 : UInt8)) = cs.dropWhile (· == 0x30) := by + simp + rw [e, decimal_zero_cons] + exact ih hcs + · have e : (c :: cs).dropWhile (· == (0x30 : UInt8)) = c :: cs := by + simp [hc] + rw [e] + refine ⟨rfl, hd, ?_⟩ + intro d rest h + simp only [List.cons.injEq] at h + rw [← h.1] + exact hc + +/-- A string of digits that starts with a digit other than 0 writes at + least 10 to the number of digits after the first. -/ +private theorem decimal_ge (d : UInt8) (rest : List UInt8) (hd : isDigit d = true) (h0 : d ≠ 0x30) : + 10 ^ rest.length ≤ decimal (d :: rest) := by + have e : decimal (d :: rest) = decimal [d] * 10 ^ rest.length + decimal rest := decimal_append [d] rest + have h1 : 1 ≤ decimal [d] := by + simp only [decimal, List.foldl_cons, List.foldl_nil] + simp only [isDigit, Bool.and_eq_true, decide_eq_true_eq] at hd + have : d.toNat ≠ 0x30 := fun h => h0 (UInt8.toNat_inj.mp h) + have := UInt8.le_iff_toNat_le.mp hd.1 + simp at this ⊢ + omega + rw [e] + calc 10 ^ rest.length = 1 * 10 ^ rest.length := (Nat.one_mul _).symm + _ ≤ decimal [d] * 10 ^ rest.length := Nat.mul_le_mul_right _ h1 + _ ≤ _ := Nat.le_add_right _ _ + +private theorem portInRange_iff (ds : List UInt8) (hd : ∀ c ∈ ds, isDigit c = true) : + portInRange ds = true ↔ 1 ≤ Spec.decimal ds ∧ Spec.decimal ds ≤ 65535 := by + obtain ⟨hdec, hdig, hlead⟩ := dropZeros ds hd + rw [← decimal_eq, ← hdec] + unfold portInRange + generalize ds.dropWhile (· == 0x30) = z at hdig hlead + simp only + split + · simp only [Bool.and_eq_true, decide_eq_true_eq] + · rename_i hlen + simp only [Bool.false_eq_true, false_iff] + rintro ⟨-, h2⟩ + cases z with + | nil => simp at hlen + | cons d rest => + have hge := decimal_ge d rest (hdig d (by simp)) (hlead d rest rfl) + have : 10 ^ 5 ≤ 10 ^ rest.length := Nat.pow_le_pow_right (by decide) (by simp at hlen; omega) + omega + +private theorem digits_iff (v : List UInt8) : + (!v.isEmpty && v.all isDigit) = true ↔ Spec.Matches Spec.contentLength v := by + rw [Fields.contentLength_iff] + cases v <;> simp + +theorem hostField_eq : Grammar.hostField = Spec.hostField := rfl + +theorem chunkedList_eq : Grammar.chunkedList = Spec.listOne (Re.litCI "chunked") := rfl + +theorem connectTarget_eq : + Grammar.connectTarget = Re.seq [Spec.hostNonEmpty, Re.litCI ":", Spec.port] := rfl + +private theorem colon_eq : Re.litCI ":" = .range 0x3A 0x3A := rfl + +/-- A CONNECT target is a host that is not empty, a colon and a port. -/ +private theorem connectTarget_iff (t : List UInt8) : + Spec.Matches (Re.seq [Spec.hostNonEmpty, Re.litCI ":", Spec.port]) t ↔ + ∃ host port, t = host ++ [0x3A] ++ port ∧ Spec.Matches Spec.hostNonEmpty host ∧ + Spec.Matches Spec.port port := by + simp only [Re.seq, colon_eq, Match.matches_cat_iff, Match.matches_range_iff] + constructor + · rintro ⟨host, _, rfl, hh, _, port, rfl, ⟨c, rfl, h1, h2⟩, hp⟩ + have hc : c = 0x3A := UInt8.le_antisymm h2 h1 + subst hc + exact ⟨host, port, by simp, hh, hp⟩ + · rintro ⟨host, port, rfl, hh, hp⟩ + exact ⟨host, [0x3A] ++ port, by simp, hh, [0x3A], port, rfl, ⟨0x3A, rfl, by decide, by decide⟩, hp⟩ + +/-- In a target `host ":" port`, `portOf` finds the port, since a colon + is not a digit. -/ +private theorem portOf_eq {host port : List UInt8} (hp : ∀ c ∈ port, isDigit c = true) : + portOf (host ++ [0x3A] ++ port) = port := by + unfold portOf + rw [List.reverse_append, List.reverse_append, + List.takeWhile_append_of_pos (fun c hc => hp c (List.mem_reverse.1 hc))] + simp [isDigit] + +theorem connectOK_iff (h : Head) : h.connectOK = true ↔ Spec.ConnectOK h := by + have ec : Spec.ascii "CONNECT" = connectName := rfl + unfold Head.connectOK Spec.ConnectOK + rw [ec] + generalize h.method = m + generalize h.target = t + simp only [Bool.or_eq_true, bne_iff_ne, ne_eq, Bool.and_eq_true, + Match.isMatch_iff, connectTarget_eq, connectTarget_iff] + constructor + · rintro (hm | ⟨⟨host, port, rfl, hh, hp⟩, hr⟩) hc + · exact absurd hc hm + · rw [portOf_eq ((Fields.port_iff port).1 hp), portInRange_iff _ ((Fields.port_iff port).1 hp)] at hr + exact ⟨host, port, rfl, hh, hp, hr.1, hr.2⟩ + · intro hc + by_cases hm : m = connectName + · obtain ⟨host, port, rfl, hh, hp, h1, h2⟩ := hc hm + rw [portOf_eq ((Fields.port_iff port).1 hp)] + exact .inr ⟨⟨host, port, rfl, hh, hp⟩, (portInRange_iff _ ((Fields.port_iff port).1 hp)).2 ⟨h1, h2⟩⟩ + · exact .inl hm + +theorem httpTarget_eq : Grammar.httpTarget = Spec.httpTarget := rfl + +/-- `Grammar.httpTarget` with its two schemes as lists of characters, + not string literals. -/ +def httpTargetChars : Re := + .seq [.alt (.seq (['h', 't', 't', 'p'].map .charCI)) (.seq (['h', 't', 't', 'p', 's'].map .charCI)), + .litCI "://", Grammar.hostNonEmpty, .opt (.cat (.litCI ":") Grammar.port), Grammar.pathAbempty, + .opt (.cat (.litCI "?") Grammar.query)] + +/-- `Head.httpTargetOK` with `httpTargetChars` in place of + `Grammar.httpTarget`. -/ +def httpTargetOKChars (h : Head) : Bool := + h.method == connectName || + !(httpColon.isPrefixOf (h.target.map lower) || httpsColon.isPrefixOf (h.target.map lower)) || + httpTargetChars.isMatch h.target + +/-- `head_vectors` rewrites with this before `decide`. Matching an http + target compares `litCI "http"` with `litCI "https"`, and the nanoda + checker runs out of stack when it reads the two from string + literals. -/ +theorem httpTargetOK_chars : Head.httpTargetOK = httpTargetOKChars := rfl + +theorem httpTargetOK_iff (h : Head) : h.httpTargetOK = true ↔ Spec.HttpTargetOK h := by + have ec : Spec.ascii "CONNECT" = connectName := rfl + have e1 : Spec.ascii "http:" = httpColon := rfl + have e2 : Spec.ascii "https:" = httpsColon := rfl + unfold Head.httpTargetOK Spec.HttpTargetOK + rw [ec, e1, e2, ← lower_eq] + generalize h.method = m + generalize h.target.map lower = l + simp only [Bool.or_eq_true, beq_iff_eq, Bool.not_eq_true', Bool.eq_false_iff, + ne_eq, List.isPrefixOf_iff_prefix, Match.isMatch_iff, httpTarget_eq] + constructor + · rintro ((hm | hp) | ht) hm' hp' + · exact absurd hm hm' + · exact absurd hp' hp + · exact ht + · intro H + by_cases hm : m = connectName + · exact .inl (.inl hm) + by_cases hp : httpColon <+: l ∨ httpsColon <+: l + · exact .inr (H hm hp) + · exact .inl (.inr hp) + +private theorem ite_none_iff {α : Type} {c : Bool} {x : Option α} {y : α} : + (if c = true then none else x) = some y ↔ c = false ∧ x = some y := by + cases c <;> simp + +private theorem ite_some_iff {α : Type} {c : Bool} {x y : α} : + (if c = true then some x else none) = some y ↔ c = true ∧ x = y := by + cases c <;> simp + +private theorem cond_iff (h : Head) (H : List Field) : + (h.major != 1 || decide (H.length > 1) || (decide (1 ≤ h.minor) && H.length != 1) || + !H.all (fun f => Grammar.hostField.isMatch f.value)) = false ↔ + h.major = 1 ∧ H.length ≤ 1 ∧ (1 ≤ h.minor → H.length = 1) ∧ + ∀ f ∈ H, Spec.Matches Spec.hostField f.value := by + simp only [Bool.or_eq_false_iff, bne_eq_false_iff_eq, decide_eq_false_iff_not, Bool.and_eq_false_imp, + decide_eq_true_eq, Bool.not_eq_false', List.all_eq_true, Match.isMatch_iff, hostField_eq] + constructor + · rintro ⟨⟨⟨h1, h2⟩, h3⟩, h4⟩ + exact ⟨h1, by omega, h3, h4⟩ + · rintro ⟨h1, h2, h3, h4⟩ + exact ⟨⟨⟨h1, by omega⟩, h3⟩, h4⟩ + +private theorem target_cond_iff (h : Head) : + (!h.connectOK || !h.httpTargetOK) = false ↔ Spec.ConnectOK h ∧ Spec.HttpTargetOK h := by + rw [Bool.or_eq_false_iff, Bool.not_eq_false', Bool.not_eq_false', connectOK_iff, httpTargetOK_iff] + +theorem framingCore_iff (h : Head) (fr : Framing) : + h.framingCore = some fr ↔ + h.major = 1 ∧ Spec.HostOK h ∧ Spec.ConnectOK h ∧ Spec.HttpTargetOK h ∧ Spec.FramedAs h fr := by + have eh : Spec.named h "host" = h.fields.filter (·.isNamed hostName) := named_eq h "host" + have et : Spec.named h "transfer-encoding" = h.fields.filter (·.isNamed transferEncodingName) := + named_eq h "transfer-encoding" + have ec : Spec.named h "content-length" = h.fields.filter (·.isNamed contentLengthName) := + named_eq h "content-length" + unfold Head.framingCore Spec.HostOK + rw [ite_none_iff, cond_iff, ite_none_iff, target_cond_iff, and_assoc, eh] + apply and_congr_right + intro _ + apply and_congr_right + intro _ + rw [and_assoc] + apply and_congr_right + intro _ + apply and_congr_right + intro _ + cases fr with + | chunked => + simp only [Spec.FramedAs] + rw [et, ec] + generalize h.fields.filter (·.isNamed transferEncodingName) = T + generalize h.fields.filter (·.isNamed contentLengthName) = C + rcases T with _ | ⟨t, T⟩ <;> rcases C with _ | ⟨c, _ | ⟨c2, C⟩⟩ <;> + (try simp only [ite_some_iff]) <;> simp [Match.isMatch_iff, chunkedList_eq, Spec.combined] + | length n => + simp only [Spec.FramedAs] + rw [et, ec] + generalize h.fields.filter (·.isNamed transferEncodingName) = T + generalize h.fields.filter (·.isNamed contentLengthName) = C + rcases T with _ | ⟨t, T⟩ <;> rcases C with _ | ⟨c, _ | ⟨c2, C⟩⟩ <;> + simp [← digits_iff, decimalFast_eq] + all_goals (intros; exact eq_comm) + +theorem framing_iff (h : Head) (fr : Framing) : h.framing = some fr ↔ Spec.Accepts h fr := by + have ec : Spec.ascii "CONNECT" = connectName := rfl + unfold Head.framing Spec.Accepts Spec.AuthorityHostOK Spec.ConnectNoContent + rw [ec] + constructor + · intro hf + cases hc : h.framingCore with + | none => rw [hc] at hf; cases hf + | some fr' => + rw [hc] at hf + simp only at hf + split at hf + · cases hf + · rename_i hcond + cases hf + obtain ⟨a, b, c, d, e⟩ := (framingCore_iff h _).1 hc + simp only [Bool.or_eq_true, beq_iff_eq, Bool.and_eq_true, bne_iff_ne, ne_eq, not_or, + not_and, Decidable.not_not] at hcond + exact ⟨a, b, c, d, hcond.1, hcond.2, e⟩ + · rintro ⟨a, b, c, d, e, g, f⟩ + rw [(framingCore_iff h fr).2 ⟨a, b, c, d, f⟩] + simp only + split + · rename_i hcond + simp only [Bool.or_eq_true, beq_iff_eq, Bool.and_eq_true, bne_iff_ne, ne_eq] at hcond + rcases hcond with h1 | ⟨h2, h3⟩ + · exact absurd h1 e + · exact absurd (g h2) h3 + · rfl + +theorem framing_te_cl (h : Head) (hte : Spec.named h "transfer-encoding" ≠ []) + (hcl : Spec.named h "content-length" ≠ []) : h.framing = none := by + cases hf : h.framing with + | none => rfl + | some fr => + have ⟨_, _, _, _, _, _, hfr⟩ := (framing_iff h fr).1 hf + cases fr with + | chunked => exact absurd hfr.2.1 hcl + | length n => exact absurd hfr.1 hte + +theorem framing_two_cl (h : Head) (h2 : 2 ≤ (Spec.named h "content-length").length) : + h.framing = none := by + cases hf : h.framing with + | none => rfl + | some fr => + have ⟨_, _, _, _, _, _, hfr⟩ := (framing_iff h fr).1 hf + cases fr with + | chunked => rw [hfr.2.1] at h2; simp at h2 + | length n => + rcases hfr.2 with ⟨hc, _⟩ | ⟨f, hc, _⟩ <;> rw [hc] at h2 <;> simp at h2 + +end Http.Proofs.Framing diff --git a/Proofs/Head.lean b/Proofs/Head.lean new file mode 100644 index 0000000..27cf1cf --- /dev/null +++ b/Proofs/Head.lean @@ -0,0 +1,169 @@ +/- + The head: `parseHead` reads exactly `Spec.Reads`, and printing. +-/ + +import Http.Head +import Spec.Defs +import Proofs.Match +import Proofs.Lines +import Proofs.Fields + +namespace Http.Proofs.Head + +open Http + +theorem requestTarget_eq : Grammar.requestTarget = Spec.requestTarget := rfl + +private theorem ascii_HTTP : Spec.ascii "HTTP/" = [0x48, 0x54, 0x54, 0x50, 0x2F] := by decide + +private theorem tchar_ne {c : UInt8} (h : isTchar c = true) : c ≠ 0x0D ∧ c ≠ 0x0A ∧ c ≠ 0x20 := by + refine ⟨?_, ?_, ?_⟩ <;> (rintro rfl; revert h; decide) + +private theorem vis_ne {c : UInt8} (h : (0x21 ≤ c && c ≤ 0x7E) = true) : + c ≠ 0x0D ∧ c ≠ 0x0A ∧ c ≠ 0x20 := by + refine ⟨?_, ?_, ?_⟩ <;> (rintro rfl; revert h; decide) + +private theorem digit_ne_aux : ∀ a, a < 10 → + Spec.digit a ≠ 0x0D ∧ Spec.digit a ≠ 0x0A ∧ Spec.digit a ≠ 0x20 := by decide + +private theorem digit_ne {a : Nat} (h : a ≤ 9) : + Spec.digit a ≠ 0x0D ∧ Spec.digit a ≠ 0x0A ∧ Spec.digit a ≠ 0x20 := + digit_ne_aux a (by omega) + +private theorem target_bytes {t : List UInt8} (ht : Spec.Matches Spec.requestTarget t) : + ∀ c ∈ t, (0x21 ≤ c && c ≤ 0x7E) = true := + Http.Proofs.Match.matches_bytes (fun c => 0x21 ≤ c && c ≤ 0x7E) Spec.requestTarget + (by decide +kernel) ht + +private theorem token_bytes {m : List UInt8} (hm : Spec.Matches Spec.method m) : + m ≠ [] ∧ ∀ c ∈ m, isTchar c = true := by + have h := (Http.Proofs.Fields.isToken_iff m).2 hm + simp only [isToken, Bool.and_eq_true, Bool.not_eq_true', List.isEmpty_eq_false_iff, + List.all_eq_true] at h + exact h + +theorem parseHead_iff (bs : List UInt8) (h : Head) (rest : List UInt8) : + parseHead bs = some (h, rest) ↔ Spec.Reads bs h rest := by + constructor + · intro hp + unfold parseHead at hp + cases h1 : takeLine (skipEmpty bs) with + | none => simp [h1] at hp + | some p => + obtain ⟨line, rest0⟩ := p + rw [h1] at hp + simp only [bind, Option.bind] at hp + split at hp + next m t v hs => + cases h2 : parseVersion v with + | none => simp [h2] at hp + | some ab => + obtain ⟨a, b⟩ := ab + rw [h2] at hp + simp only at hp + split at hp + next hc => + cases h3 : parseFields (rest0.length + 1) rest0 with + | none => simp [h3] at hp + | some q => + obtain ⟨fs, rest'⟩ := q + rw [h3] at hp + simp only [pure, Option.some.injEq, Prod.mk.injEq] at hp + obtain ⟨rfl, rfl⟩ := hp + obtain ⟨k, hk⟩ := Http.Proofs.Lines.skipEmpty_eq bs + obtain ⟨-, hl⟩ := (Http.Proofs.Lines.takeLine_iff _ _ _).1 h1 + obtain ⟨hline, -, -, -⟩ := Http.Proofs.Lines.splitOn_three_inv line m t v hs + obtain ⟨ha, hb, hv⟩ := (Http.Proofs.Lines.parseVersion_iff v a b).1 h2 + rw [Bool.and_eq_true] at hc + obtain ⟨hm, ht⟩ := hc + obtain ⟨hfv, tf, hft, hr⟩ := + (Http.Proofs.Fields.parseFields_iff _ rest0 fs rest' (by omega)).1 h3 + refine ⟨⟨(Http.Proofs.Fields.isToken_iff m).1 hm, + (Http.Proofs.Match.isMatch_iff _ t).1 ht, ha, hb, hfv⟩, k, _, ⟨tf, hft, rfl⟩, ?_⟩ + rw [hk, hl, hr, hline, hv] + simp [Spec.requestLine] + next => simp at hp + next => simp at hp + · rintro ⟨hv, k, tt, ⟨tf, hft, rfl⟩, rfl⟩ + obtain ⟨m, t, a, b, fs⟩ := h + obtain ⟨hm, ht, ha, hb, hf⟩ := hv + simp only at hm ht ha hb hf hft + obtain ⟨hmne, hmc⟩ := token_bytes hm + have htc := target_bytes ht + have hmb : ∀ c ∈ m, c ≠ 0x0D ∧ c ≠ 0x0A ∧ c ≠ 0x20 := fun c hc => tchar_ne (hmc c hc) + have htb : ∀ c ∈ t, c ≠ 0x0D ∧ c ≠ 0x0A ∧ c ≠ 0x20 := fun c hc => vis_ne (htc c hc) + have hvb : ∀ c ∈ Spec.ascii "HTTP/" ++ [Spec.digit a, 0x2E, Spec.digit b], + c ≠ 0x0D ∧ c ≠ 0x0A ∧ c ≠ 0x20 := by + rw [ascii_HTTP] + intro c hc + simp only [List.cons_append, List.nil_append, List.mem_cons, List.not_mem_nil, or_false] at hc + rcases hc with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + all_goals first | exact digit_ne ha | exact digit_ne hb | decide + obtain ⟨c, m', rfl⟩ : ∃ c m', m = c :: m' := by + cases m with + | nil => exact absurd rfl hmne + | cons c m' => exact ⟨c, m', rfl⟩ + have hrl : Spec.requestLine ⟨c :: m', t, a, b, fs⟩ = + (c :: m') ++ [0x20] ++ t ++ [0x20] ++ (Spec.ascii "HTTP/" ++ [Spec.digit a, 0x2E, Spec.digit b]) := by + simp [Spec.requestLine] + have hall : ∀ x ∈ Spec.requestLine ⟨c :: m', t, a, b, fs⟩, x ≠ 0x0D ∧ x ≠ 0x0A := by + intro x hx + rw [hrl] at hx + simp only [List.mem_append, List.mem_singleton] at hx + rcases hx with (((hx | rfl) | hx) | rfl) | hx + · exact ⟨(hmb x hx).1, (hmb x hx).2.1⟩ + · decide + · exact ⟨(htb x hx).1, (htb x hx).2.1⟩ + · decide + · exact ⟨(hvb x (List.mem_append.2 hx)).1, (hvb x (List.mem_append.2 hx)).2.1⟩ + have hskip : skipEmpty ((List.replicate k Spec.crlf).flatten ++ + (Spec.requestLine ⟨c :: m', t, a, b, fs⟩ ++ Spec.crlf ++ tf) ++ rest) = + Spec.requestLine ⟨c :: m', t, a, b, fs⟩ ++ Spec.crlf ++ (tf ++ rest) := by + rw [List.append_assoc, Http.Proofs.Lines.skipEmpty_crlf] + have : Spec.requestLine ⟨c :: m', t, a, b, fs⟩ ++ Spec.crlf ++ tf ++ rest = + c :: (m' ++ [0x20] ++ t ++ [0x20] ++ (Spec.ascii "HTTP/" ++ + [Spec.digit a, 0x2E, Spec.digit b]) ++ Spec.crlf ++ (tf ++ rest)) := by + rw [hrl]; simp + rw [this, Http.Proofs.Lines.skipEmpty_cons _ _ (hmb c (by simp)).1] + rw [← this]; simp + have htake : takeLine (Spec.requestLine ⟨c :: m', t, a, b, fs⟩ ++ Spec.crlf ++ (tf ++ rest)) = + some (Spec.requestLine ⟨c :: m', t, a, b, fs⟩, tf ++ rest) := + (Http.Proofs.Lines.takeLine_iff _ _ _).2 + ⟨⟨fun hx => (hall _ hx).1 rfl, fun hx => (hall _ hx).2 rfl⟩, rfl⟩ + have hsplit : (Spec.requestLine ⟨c :: m', t, a, b, fs⟩).splitOn 0x20 = + [c :: m', t, Spec.ascii "HTTP/" ++ [Spec.digit a, 0x2E, Spec.digit b]] := by + rw [hrl] + exact Http.Proofs.Lines.splitOn_three _ _ _ + (fun hx => (hmb _ hx).2.2 rfl) (fun hx => (htb _ hx).2.2 rfl) (fun hx => (hvb _ hx).2.2 rfl) + have hver : parseVersion (Spec.ascii "HTTP/" ++ [Spec.digit a, 0x2E, Spec.digit b]) = some (a, b) := + (Http.Proofs.Lines.parseVersion_iff _ a b).2 ⟨ha, hb, rfl⟩ + have htok : isToken (c :: m') = true := (Http.Proofs.Fields.isToken_iff _).2 hm + have hmat : Grammar.requestTarget.isMatch t = true := (Http.Proofs.Match.isMatch_iff _ t).2 ht + have hfld : parseFields ((tf ++ rest).length + 1) (tf ++ rest) = some (fs, rest) := + (Http.Proofs.Fields.parseFields_iff _ _ fs rest (by omega)).2 ⟨hf, tf, hft, rfl⟩ + unfold parseHead + rw [hskip, htake] + simp only [Option.bind_eq_bind, Option.bind_some] + rw [hsplit] + simp only [hver, htok, hmat, Bool.and_self, ite_true, hfld, pure, Option.bind_some] + +theorem print_eq (h : Head) : h.print = Spec.render h := by + simp [Head.print, Spec.render, Spec.requestLine, ascii_HTTP, Spec.digit, Spec.crlf] + +private theorem fieldsText_render (fs : List Field) : + Spec.FieldsText fs + ((fs.map fun f => f.name ++ [0x3A, 0x20] ++ f.value ++ Spec.crlf).flatten ++ Spec.crlf) := by + induction fs with + | nil => simp [Spec.FieldsText] + | cons f fs ih => + refine ⟨f.name ++ [0x3A, 0x20] ++ f.value, _, ⟨[0x20], [], ?_, ?_, by simp⟩, ih, by simp⟩ + · exact (Http.Proofs.Fields.OWS_iff _).2 (by decide) + · exact (Http.Proofs.Fields.OWS_iff _).2 (by simp) + +theorem parseHead_print (h : Head) (rest : List UInt8) (hv : Spec.HeadValid h) : + parseHead (h.print ++ rest) = some (h, rest) := by + rw [parseHead_iff] + refine ⟨hv, 0, Spec.render h, ⟨_, fieldsText_render h.fields, ?_⟩, by simp [print_eq]⟩ + simp [Spec.render] + +end Http.Proofs.Head diff --git a/Proofs/Lines.lean b/Proofs/Lines.lean new file mode 100644 index 0000000..2b406d5 --- /dev/null +++ b/Proofs/Lines.lean @@ -0,0 +1,241 @@ +/- + Lines, empty lines, the three parts of the request line, and the + version. +-/ + +import Http.Head +import Spec.Defs + +namespace Http.Proofs.Lines + +open Http + +theorem takeLineFrom_eq (acc bs : List UInt8) : + takeLineFrom acc bs = (takeLine bs).map fun p => (acc.reverse ++ p.1, p.2) := by + unfold takeLine + induction bs generalizing acc with + | nil => simp [takeLineFrom] + | cons c rest ih => + simp only [takeLineFrom] + split + · split + · split <;> simp + · simp + · split + · simp + · rw [ih, ih [c], Option.map_map] + congr 1 + funext p + simp + +theorem takeLine_nil : takeLine [] = none := rfl + +/-- `takeLine` as a recursion on the octets, one at a time. -/ +theorem takeLine_cons (c : UInt8) (rest : List UInt8) : + takeLine (c :: rest) = + if c == 0x0D then + match rest with + | d :: rest' => if d == 0x0A then some ([], rest') else none + | [] => none + else if c == 0x0A then none + else (takeLine rest).map fun p => (c :: p.1, p.2) := by + conv => lhs; unfold takeLine + simp only [takeLineFrom] + split + · rfl + · split + · rfl + · rw [takeLineFrom_eq] + simp + +theorem takeLine_iff (bs l r : List UInt8) : + takeLine bs = some (l, r) ↔ (0x0D ∉ l ∧ 0x0A ∉ l) ∧ bs = l ++ Spec.crlf ++ r := by + induction bs generalizing l with + | nil => + simp [takeLine_nil, Spec.crlf] + | cons c rest ih => + by_cases hc : c = 0x0D + · subst hc + cases l with + | nil => + cases rest with + | nil => simp [takeLine_cons, Spec.crlf] + | cons d rest' => + by_cases hd : d = 0x0A + · subst hd; simp [takeLine_cons, Spec.crlf] + · simp [takeLine_cons, Spec.crlf, hd] + | cons x l' => + constructor + · intro h + cases rest with + | nil => simp [takeLine_cons] at h + | cons d rest' => + by_cases hd : d = 0x0A + · subst hd; simp [takeLine_cons] at h + · simp [takeLine_cons, hd] at h + · rintro ⟨⟨h1, _⟩, h2⟩ + simp at h2 + exact absurd (h2.1 ▸ List.mem_cons_self) h1 + · by_cases hc' : c = 0x0A + · subst hc' + constructor + · intro h; simp [takeLine_cons] at h + · rintro ⟨⟨h1, h1'⟩, h2⟩ + cases l with + | nil => simp [Spec.crlf] at h2 + | cons x l' => + simp at h2 + exact absurd (h2.1 ▸ List.mem_cons_self) h1' + · have e : takeLine (c :: rest) = (takeLine rest).map fun p => (c :: p.1, p.2) := by + simp [takeLine_cons, hc, hc'] + rw [e] + cases l with + | nil => + simp [Spec.crlf, hc] + | cons x l' => + constructor + · intro h + simp only [Option.map_eq_some_iff] at h + obtain ⟨⟨p1, p2⟩, hp, he⟩ := h + simp at he + obtain ⟨⟨rfl, rfl⟩, rfl⟩ := he + have := (ih p1).mp hp + have hc1 : ¬ (13 : UInt8) = c := fun h => hc h.symm + have hc2 : ¬ (10 : UInt8) = c := fun h => hc' h.symm + simp_all + · rintro ⟨⟨h1, h1'⟩, h2⟩ + simp at h2 + obtain ⟨rfl, h3⟩ := h2 + have : takeLine rest = some (l', r) := + (ih l').mpr ⟨⟨by simp_all, by simp_all⟩, by simp [h3]⟩ + simp [this] + +private theorem skipEmpty_crlf_cons (bs : List UInt8) : + skipEmpty (0x0D :: 0x0A :: bs) = skipEmpty bs := by + rw [skipEmpty.eq_1]; simp + +theorem skipEmpty_crlf (k : Nat) (bs : List UInt8) : + skipEmpty ((List.replicate k Spec.crlf).flatten ++ bs) = skipEmpty bs := by + induction k with + | zero => simp + | succ k ih => + rw [List.replicate_succ, List.flatten_cons, List.append_assoc] + rw [← ih] + exact skipEmpty_crlf_cons _ + +theorem skipEmpty_eq (bs : List UInt8) : + ∃ k, bs = (List.replicate k Spec.crlf).flatten ++ skipEmpty bs := by + fun_induction skipEmpty with + | case1 c d rest h ih => + obtain ⟨k, hk⟩ := ih + refine ⟨k + 1, ?_⟩ + simp at h + obtain ⟨rfl, rfl⟩ := h + rw [List.replicate_succ, List.flatten_cons, List.append_assoc, ← hk] + rfl + | case2 c d rest h => exact ⟨0, by simp⟩ + | case3 bs h => exact ⟨0, by simp⟩ + +theorem skipEmpty_cons (c : UInt8) (bs : List UInt8) (hc : c ≠ 0x0D) : + skipEmpty (c :: bs) = c :: bs := by + cases bs with + | nil => simp [skipEmpty] + | cons d rest => rw [skipEmpty.eq_1]; simp [hc] + +/-- What `skipEmpty` leaves does not start with CRLF. -/ +theorem skipEmpty_head (bs rest : List UInt8) (h : skipEmpty bs = 0x0D :: 0x0A :: rest) : False := by + fun_induction skipEmpty with + | case1 c d rest' hcd ih => exact ih h + | case2 c d rest' hcd => + simp at h + obtain ⟨rfl, rfl, rfl⟩ := h + simp at hcd + | case3 bs hbs => exact hbs _ _ _ h + +theorem splitOn_three (m t v : List UInt8) (hm : 0x20 ∉ m) (ht : 0x20 ∉ t) (hv : 0x20 ∉ v) : + (m ++ [0x20] ++ t ++ [0x20] ++ v).splitOn 0x20 = [m, t, v] := by + have e : m ++ [0x20] ++ t ++ [0x20] ++ v = [(0x20 : UInt8)].intercalate [m, t, v] := by + simp [List.intercalate] + rw [e] + apply List.splitOn_intercalate + · intro l hl + simp at hl + rcases hl with rfl | rfl | rfl <;> assumption + · simp + +private theorem splitOnPPrepend_parts (p : UInt8 → Bool) (xs : List UInt8) : + ∀ acc : List UInt8, (∀ x ∈ acc, p x = false) → + ∀ l ∈ List.splitOnPPrepend p xs acc, ∀ x ∈ l, p x = false := by + induction xs with + | nil => + intro acc hacc l hl x hx + simp at hl + subst hl + exact hacc x (List.mem_reverse.mp hx) + | cons a t ih => + intro acc hacc l hl x hx + rw [List.splitOnPPrepend_cons_eq_ite] at hl + split at hl + · rcases List.mem_cons.mp hl with rfl | hl + · exact hacc x (List.mem_reverse.mp hx) + · exact ih [] (by simp) l hl x hx + · refine ih (a :: acc) ?_ l hl x hx + intro y hy + simp at hy + rcases hy with rfl | hy + · simpa using ‹¬p y = true› + · exact hacc y hy + +private theorem splitOn_parts (xs l : List UInt8) (hl : l ∈ xs.splitOn 0x20) : (0x20 : UInt8) ∉ l := by + intro h + have := splitOnPPrepend_parts (fun x => x == 0x20) xs [] (by simp) l hl _ h + simp at this + +theorem splitOn_three_inv (line m t v : List UInt8) (h : line.splitOn 0x20 = [m, t, v]) : + line = m ++ [0x20] ++ t ++ [0x20] ++ v ∧ 0x20 ∉ m ∧ 0x20 ∉ t ∧ 0x20 ∉ v := by + refine ⟨?_, splitOn_parts line m (by simp [h]), splitOn_parts line t (by simp [h]), + splitOn_parts line v (by simp [h])⟩ + have := List.intercalate_splitOn (xs := line) (0x20 : UInt8) + rw [h] at this + rw [← this] + simp [List.intercalate] + +private theorem digit_toNat (n : Nat) (hn : n ≤ 9) : (Spec.digit n).toNat = 0x30 + n := by + simp [Spec.digit] + omega + +theorem parseVersion_iff (v : List UInt8) (a b : Nat) : + parseVersion v = some (a, b) ↔ + a ≤ 9 ∧ b ≤ 9 ∧ v = Spec.ascii "HTTP/" ++ [Spec.digit a, 0x2E, Spec.digit b] := by + have hs : Spec.ascii "HTTP/" = [0x48, 0x54, 0x54, 0x50, 0x2F] := by decide + rw [hs] + unfold parseVersion + split + · rename_i h t1 t2 p s x dot y + constructor + · intro hp + split at hp + · rename_i hc + simp [isDigit, UInt8.le_iff_toNat_le] at hc hp + obtain ⟨⟨⟨⟨⟨⟨⟨rfl, rfl⟩, rfl⟩, rfl⟩, rfl⟩, rfl⟩, ⟨hx1, hx2⟩⟩, ⟨hy1, hy2⟩⟩ := hc + obtain ⟨rfl, rfl⟩ := hp + refine ⟨by omega, by omega, ?_⟩ + simp only [List.cons_append, List.nil_append, List.cons.injEq, and_true, true_and] + constructor + · apply UInt8.toNat_inj.mp; rw [digit_toNat _ (by omega)]; omega + · apply UInt8.toNat_inj.mp; rw [digit_toNat _ (by omega)]; omega + · simp at hp + · rintro ⟨ha, hb, he⟩ + simp only [List.cons_append, List.nil_append, List.cons.injEq, and_true] at he + obtain ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ := he + have da := digit_toNat a ha + have db := digit_toNat b hb + simp [isDigit, UInt8.le_iff_toNat_le, da, db] + omega + · rename_i hne + simp only [reduceCtorEq, false_iff] + rintro ⟨-, -, he⟩ + simp only [List.cons_append, List.nil_append] at he + exact hne _ _ _ _ _ _ _ _ he + +end Http.Proofs.Lines diff --git a/Proofs/Main.lean b/Proofs/Main.lean new file mode 100644 index 0000000..7601370 --- /dev/null +++ b/Proofs/Main.lean @@ -0,0 +1,178 @@ +/- + The proofs of the statements in `Spec.lean`, under the same names. +-/ + +import Http +import Spec.Abnf +import Spec.Rules +import Spec.Defs +import Proofs.Match +import Proofs.Head +import Proofs.Framing + +open Http + +/-! ## The grammar notation -/ + +/-- The matcher decides what a rule matches. -/ +theorem Spec.isMatch_iff (r : Re) (s : List UInt8) : r.isMatch s = true ↔ Spec.Matches r s := + Proofs.Match.isMatch_iff r s + +/-! ## The head -/ + +/-- `parseHead` reads exactly the request heads of the grammar of + RFC 9112, RFC 9110 and RFC 3986, after any empty lines, with the choices in + `Spec/Defs.lean`, and returns the head as written and the octets + after it. -/ +theorem Spec.parseHead_iff (bs : List UInt8) (h : Head) (rest : List UInt8) : + parseHead bs = some (h, rest) ↔ Spec.Reads bs h rest := + Proofs.Head.parseHead_iff bs h rest + +/-- A head prints as the grammar writes it, with one SP after each + colon. -/ +theorem Spec.print_eq (h : Head) : h.print = Spec.render h := + Proofs.Head.print_eq h + +/-- Round trip: printing a head of the grammar, then parsing it, gives + it back, whatever follows it. -/ +theorem Spec.parseHead_print (h : Head) (rest : List UInt8) (hv : Spec.HeadValid h) : + parseHead (h.print ++ rest) = some (h, rest) := + Proofs.Head.parseHead_print h rest hv + +/-! ## Acceptance and framing -/ + +/-- `framing` decides which heads this library accepts, by the version, + the Host rule of RFC 9112 section 3.2, the CONNECT rule of RFC 9110 + section 9.3.6, the rule of RFC 9110 section 4.2 for http and https + targets, and RFC 9112 section 6.3 with the choices in + `Spec/Defs.lean`, and how it frames the body. -/ +theorem Spec.framing_iff (h : Head) (fr : Framing) : h.framing = some fr ↔ Spec.Accepts h fr := + Proofs.Framing.framing_iff h fr + +/-- A head with both Transfer-Encoding and Content-Length is rejected. -/ +theorem Spec.framing_te_cl (h : Head) (hte : Spec.named h "transfer-encoding" ≠ []) + (hcl : Spec.named h "content-length" ≠ []) : h.framing = none := + Proofs.Framing.framing_te_cl h hte hcl + +/-- A head with two Content-Length field lines is rejected, even when + they agree. -/ +theorem Spec.framing_two_cl (h : Head) (h2 : 2 ≤ (Spec.named h "content-length").length) : + h.framing = none := + Proofs.Framing.framing_two_cl h h2 + +/-- Test vectors, each with the answer `framing` gives. + - Accepted, with no body: the examples of RFC 9112 sections 3.2.1 to + 3.2.4, an HTTP/1.0 request with no Host, an empty Host value, + `CONNECT [::1]:65535`, `CONNECT http:80` (the host `http`), and + `HTTP://a:/x` (a scheme in upper case and an empty port). + - Accepted with a body: `Content-Length: 5`, and Transfer-Encoding + lists of the one coding `chunked`, in any case, with empty + elements, which RFC 9110 section 5.6.1.2 says a recipient must + accept, and after a tab or more than one space. + - Rejected, the classic shapes of request smuggling: two + Content-Length values, Content-Length with Transfer-Encoding, a + Transfer-Encoding value other than a list of the one coding + `chunked`, chunked twice, two Transfer-Encoding lines that list + another coding, `chunked` with a parameter, whitespace before a + colon, a folded line, a bare LF, a bare CR, and Transfer-Encoding + in HTTP/1.0. + - Rejected too: an HTTP/1.1 request with no Host or with two; a Host + value with an empty host, `:80` or `:`; a CONNECT with an empty + port, port 0, a port above 65535, an empty host, or a target that + is not a host and port; a CONNECT with content, by Content-Length + or Transfer-Encoding (a CONNECT with `Content-Length: 0` is + accepted); an authority-form target with an empty host for any + method, `GET :80` and `OPTIONS :`; and an http or https target with + no authority, an empty host or userinfo. -/ +theorem Spec.head_vectors : + -- Sections 3.2.1 to 3.2.4 + (parseHead (Spec.ascii "GET /where?q=now HTTP/1.1\r\nHost: www.example.org\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii + "GET http://www.example.org/pub/WWW/TheProject.html HTTP/1.1\r\nHost: www.example.org\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "CONNECT www.example.com:80 HTTP/1.1\r\nHost: www.example.com\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "OPTIONS * HTTP/1.1\r\nHost: www.example.org:8001\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- A body framed by length and by chunked coding + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\n\r\nhello")).map + (fun p => (p.1.framing, p.2)) = some (some (.length 5), Spec.ascii "hello") ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: Chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Lists with empty elements (RFC 9110, section 5.6.1.2) + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: , chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding:\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Optional whitespace before the value: a tab, and two spaces + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\tchunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Smuggling shapes + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 6\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: xchunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, identity\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked;a=b\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding: x\r\n\r\n")).bind + (·.1.framing) = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding : chunked\r\n\r\n") = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nX: y\r\n Transfer-Encoding: chunked\r\n\r\n") = + none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\nTransfer-Encoding: chunked\r\n\r\n") = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\rTransfer-Encoding: chunked\r\n\r\n") = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.0\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + -- The Host rule + (parseHead (Spec.ascii "GET / HTTP/1.1\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: a\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.0\r\n\r\n")).bind (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost:\r\n\r\n")).bind (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: :80\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: :\r\n\r\n")).bind (·.1.framing) = none ∧ + -- The CONNECT rule (RFC 9110, section 9.3.6) + (parseHead (Spec.ascii "CONNECT a: HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:0 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:65536 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT / HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT :80 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT [::1]:65535 HTTP/1.1\r\nHost: a\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- A CONNECT has no content (RFC 9110, section 9.3.6) + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 5\r\n\r\nhello")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 0\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- An authority-form target with an empty host, for any method (RFC 9112, section 3.3) + (parseHead (Spec.ascii "GET :80 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "OPTIONS : HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + -- http and https targets (RFC 9110, sections 4.2.1, 4.2.2 and 4.2.4) + (parseHead (Spec.ascii "GET http: HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET http:///a HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET https://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET HTTP://a:/x HTTP/1.1\r\nHost: a\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "CONNECT http:80 HTTP/1.1\r\nHost: http\r\n\r\n")).bind + (·.1.framing) = some (.length 0) := by + simp only [Head.framing, Head.framingCore] + rw [Proofs.Framing.httpTargetOK_chars] + and_intros <;> decide +kernel diff --git a/Proofs/Match.lean b/Proofs/Match.lean new file mode 100644 index 0000000..ff45f67 --- /dev/null +++ b/Proofs/Match.lean @@ -0,0 +1,235 @@ +/- + The matcher: `isMatch` decides `Spec.Matches`, through the + derivative, the simplifying constructors and `nullable`. And a test + that bounds the octets any string a rule matches can hold. +-/ + +import Http.Match +import Spec.Abnf + +namespace Http.Proofs.Match + +open Http Http.Re + +theorem matches_empty_iff (s : List UInt8) : Spec.Matches .empty s ↔ False := + ⟨fun h => (by cases h), False.elim⟩ + +theorem matches_eps_iff (s : List UInt8) : Spec.Matches .eps s ↔ s = [] := + ⟨fun h => by cases h; rfl, fun h => h ▸ .eps⟩ + +theorem matches_range_iff (lo hi : UInt8) (s : List UInt8) : + Spec.Matches (.range lo hi) s ↔ ∃ c, s = [c] ∧ lo ≤ c ∧ c ≤ hi := by + constructor + · intro h; cases h with + | range h1 h2 => exact ⟨_, rfl, h1, h2⟩ + · rintro ⟨c, rfl, h1, h2⟩; exact .range h1 h2 + +theorem matches_cat_iff (a b : Re) (s : List UInt8) : + Spec.Matches (.cat a b) s ↔ ∃ s1 s2, s = s1 ++ s2 ∧ Spec.Matches a s1 ∧ Spec.Matches b s2 := by + constructor + · intro h; cases h with + | cat h1 h2 => exact ⟨_, _, rfl, h1, h2⟩ + · rintro ⟨s1, s2, rfl, h1, h2⟩; exact .cat h1 h2 + +theorem matches_alt_iff (a b : Re) (s : List UInt8) : + Spec.Matches (.alt a b) s ↔ Spec.Matches a s ∨ Spec.Matches b s := by + constructor + · intro h; cases h with + | altL h => exact Or.inl h + | altR h => exact Or.inr h + · rintro (h | h) + · exact .altL h + · exact .altR h + +theorem matches_star_inv {a : Re} {s : List UInt8} (h : Spec.Matches (.star a) s) : + s = [] ∨ ∃ s1 s2, s = s1 ++ s2 ∧ s1 ≠ [] ∧ Spec.Matches a s1 ∧ Spec.Matches (.star a) s2 := by + generalize hr : Re.star a = r at h + induction h with + | eps => cases hr + | range _ _ => cases hr + | cat _ _ => cases hr + | altL _ => cases hr + | altR _ => cases hr + | starNil => exact Or.inl rfl + | @starCons a' s t h1 h2 _ ih2 => + cases hr + by_cases hs : s = [] + · subst hs + exact ih2 rfl + · exact Or.inr ⟨s, t, rfl, hs, h1, h2⟩ + +theorem nullable_iff (r : Re) : r.nullable = true ↔ Spec.Matches r [] := by + induction r with + | empty => simp [nullable, matches_empty_iff] + | eps => simp [nullable, matches_eps_iff] + | range lo hi => simp [nullable, matches_range_iff] + | cat a b iha ihb => + simp only [nullable, Bool.and_eq_true, iha, ihb, matches_cat_iff] + constructor + · rintro ⟨h1, h2⟩; exact ⟨[], [], rfl, h1, h2⟩ + · rintro ⟨s1, s2, h, h1, h2⟩ + have h' := h.symm + rw [List.append_eq_nil_iff] at h' + obtain ⟨rfl, rfl⟩ := h' + exact ⟨h1, h2⟩ + | alt a b iha ihb => + simp only [nullable, Bool.or_eq_true, iha, ihb, matches_alt_iff] + | star a => simp only [nullable, true_iff]; exact .starNil + +theorem mkCat_iff (a b : Re) (s : List UInt8) : + Spec.Matches (mkCat a b) s ↔ Spec.Matches (.cat a b) s := by + have e1 : ∀ b s, Spec.Matches (.cat .empty b) s ↔ False := by + intro b s; simp [matches_cat_iff, matches_empty_iff] + have e2 : ∀ a s, Spec.Matches (.cat a .empty) s ↔ False := by + intro a s; simp [matches_cat_iff, matches_empty_iff] + have e3 : ∀ b s, Spec.Matches (.cat .eps b) s ↔ Spec.Matches b s := by + intro b s + rw [matches_cat_iff] + constructor + · rintro ⟨s1, s2, rfl, h1, h2⟩ + rw [matches_eps_iff] at h1 + subst h1 + exact h2 + · intro h + exact ⟨[], s, rfl, .eps, h⟩ + have e4 : ∀ a s, Spec.Matches (.cat a .eps) s ↔ Spec.Matches a s := by + intro a s + rw [matches_cat_iff] + constructor + · rintro ⟨s1, s2, rfl, h1, h2⟩ + rw [matches_eps_iff] at h2 + subst h2 + simpa using h1 + · intro h + exact ⟨s, [], by simp, h, .eps⟩ + cases a <;> cases b <;> simp only [mkCat, e1, e2, e3, e4, matches_empty_iff] + +theorem mkAlt_iff (a b : Re) (s : List UInt8) : + Spec.Matches (mkAlt a b) s ↔ Spec.Matches (.alt a b) s := by + unfold mkAlt + split + · simp [matches_alt_iff, matches_empty_iff] + · simp [matches_alt_iff, matches_empty_iff] + · split + · rename_i h; subst h; simp [matches_alt_iff] + · split + · split + · rename_i h; subst h; simp only [matches_alt_iff, or_assoc, or_self] + · exact Iff.rfl + · exact Iff.rfl + +theorem deriv_iff (c : UInt8) (r : Re) (s : List UInt8) : + Spec.Matches (deriv c r) s ↔ Spec.Matches r (c :: s) := by + induction r generalizing s with + | empty => simp [deriv, matches_empty_iff] + | eps => simp [deriv, matches_empty_iff, matches_eps_iff] + | range lo hi => + simp only [deriv, matches_range_iff] + split + · rename_i h + rw [matches_eps_iff] + constructor + · rintro rfl; exact ⟨c, rfl, h.1, h.2⟩ + · rintro ⟨d, hd, _⟩ + cases hd + rfl + · rename_i h + simp only [matches_empty_iff, false_iff] + rintro ⟨d, hd, h1, h2⟩ + cases hd + exact h ⟨h1, h2⟩ + | cat a b iha ihb => + simp only [deriv] + split + · rename_i hn + rw [mkAlt_iff, matches_alt_iff, mkCat_iff, matches_cat_iff, ihb, matches_cat_iff] + constructor + · rintro (⟨s1, s2, rfl, h1, h2⟩ | h) + · exact ⟨c :: s1, s2, rfl, (iha s1).1 h1, h2⟩ + · exact ⟨[], c :: s, rfl, (nullable_iff a).1 hn, h⟩ + · rintro ⟨s1, s2, hs, h1, h2⟩ + cases s1 with + | nil => exact Or.inr (by simpa using hs ▸ h2) + | cons d s1 => + simp only [List.cons_append, List.cons.injEq] at hs + obtain ⟨rfl, rfl⟩ := hs + exact Or.inl ⟨s1, s2, rfl, (iha s1).2 h1, h2⟩ + · rename_i hn + rw [mkCat_iff, matches_cat_iff, matches_cat_iff] + constructor + · rintro ⟨s1, s2, rfl, h1, h2⟩ + exact ⟨c :: s1, s2, rfl, (iha s1).1 h1, h2⟩ + · rintro ⟨s1, s2, hs, h1, h2⟩ + cases s1 with + | nil => exact absurd ((nullable_iff a).2 h1) hn + | cons d s1 => + simp only [List.cons_append, List.cons.injEq] at hs + obtain ⟨rfl, rfl⟩ := hs + exact ⟨s1, s2, rfl, (iha s1).2 h1, h2⟩ + | alt a b iha ihb => + simp only [deriv] + rw [mkAlt_iff, matches_alt_iff, matches_alt_iff, iha, ihb] + | star a iha => + simp only [deriv] + rw [mkCat_iff, matches_cat_iff] + constructor + · rintro ⟨s1, s2, rfl, h1, h2⟩ + exact .starCons ((iha s1).1 h1) h2 + · intro h + rcases matches_star_inv h with h | ⟨s1, s2, hs, hne, h1, h2⟩ + · cases h + · cases s1 with + | nil => exact absurd rfl hne + | cons d s1 => + simp only [List.cons_append, List.cons.injEq] at hs + obtain ⟨rfl, rfl⟩ := hs + exact ⟨s1, s2, rfl, (iha s1).2 h1, h2⟩ + +theorem isMatch_iff (r : Re) (s : List UInt8) : r.isMatch s = true ↔ Spec.Matches r s := by + induction s generalizing r with + | nil => simp only [isMatch]; exact nullable_iff r + | cons c cs ih => simp only [isMatch]; rw [ih, deriv_iff] + +/-- Every octet in every range of the rule passes `p`. -/ +def allBytes (p : UInt8 → Bool) : Re → Bool + | .empty => true + | .eps => true + | .range lo hi => (List.range 256).all fun n => !(lo ≤ n.toUInt8 && n.toUInt8 ≤ hi) || p n.toUInt8 + | .cat a b => allBytes p a && allBytes p b + | .alt a b => allBytes p a && allBytes p b + | .star a => allBytes p a + +theorem matches_bytes (p : UInt8 → Bool) (r : Re) (h : allBytes p r = true) {s : List UInt8} + (hm : Spec.Matches r s) : ∀ c ∈ s, p c = true := by + induction hm with + | eps => intro c hc; cases hc + | @range lo hi c h1 h2 => + intro d hd + simp only [List.mem_singleton] at hd + subst hd + simp only [allBytes, List.all_eq_true, List.mem_range] at h + have := h d.toNat (UInt8.toNat_lt d) + simp only [UInt8.ofNat_toNat] at this + have h1' : decide (lo ≤ d) = true := decide_eq_true h1 + have h2' : decide (d ≤ hi) = true := decide_eq_true h2 + simpa [h1', h2'] using this + | cat _ _ iha ihb => + simp only [allBytes, Bool.and_eq_true] at h + intro c hc + rcases List.mem_append.1 hc with hc | hc + · exact iha h.1 c hc + · exact ihb h.2 c hc + | altL _ ih => + simp only [allBytes, Bool.and_eq_true] at h + exact ih h.1 + | altR _ ih => + simp only [allBytes, Bool.and_eq_true] at h + exact ih h.2 + | starNil => intro c hc; cases hc + | starCons _ _ iha ihb => + intro c hc + rcases List.mem_append.1 hc with hc | hc + · exact iha h c hc + · exact ihb h c hc + +end Http.Proofs.Match diff --git a/README.md b/README.md index 2da4a73..3bd8700 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,145 @@ -# http -lean HTTP request-line and header parser (RFC 9112) +# http: HTTP/1.1 request heads, proved + +This library reads the head of an HTTP/1.1 request, as in `GET /where?q=now HTTP/1.1` followed by its header fields. The head is the request line, the field lines and the empty line that ends them. The library then decides whether to refuse the request, and if not, how the body after the head is framed: by a length, or by the chunked coding. Each refusal is either required by the RFCs or allowed by them and chosen here. `SPEC.md` lists which is which. Machine-checked proofs show three things: +- It reads exactly the heads that the grammar of RFC 9112, RFC 9110 and RFC 3986 allows, with every part as written. +- Printing a head of the grammar and reading it back gives the same head. +- Its refusals and its framing follow the rules of RFC 9112 sections 3.2, 3.3 and 6.3 and RFC 9110 sections 4.2 and 9.3.6, with the choices in `SPEC.md`. + +Where the RFC lets a recipient choose between rejecting a malformed request and repairing it, this library rejects. That includes a bare CR or LF, a folded line, and Transfer-Encoding with Content-Length. Whitespace before a colon is not a choice: RFC 9112 section 5.1 says a server MUST reject it, and this library does. + +These are the points where two servers can read the same bytes as different requests. That difference is request smuggling. Some public cases: +- In Node's llhttp, Transfer-Encoding was not parsed and checked correctly (CVE-2022-32213), and requests were not strictly delimited by CRLF (CVE-2022-32214). +- Go's net/http accepted, and normalized, a space before the colon in a field name (CVE-2019-16276). + +The library is tested against a separate Python copy of the same rules. `tests/TEST-RESULTS.md` has the record of the last run. + +It is a project of [Proven Commons](https://github.com/Proven-Commons/mission), built to the verified bar published there. + +Status: in progress. The specification has not yet been approved by a reviewer apart from its author, so this is not verified. + +## Use it + +``` +lake build +printf 'POST /a HTTP/1.1\r\nHost: example.org\r\nContent-Length: 5\r\n\r\nhello' | .lake/build/bin/httphead check +``` + +It prints the request line and each field, then the framing, here `length 5`. It prints `reject` when this library refuses the request, and `invalid` when the input does not start with a head of the grammar. It exits with 0 only for a request this library accepts. From Lean, the functions are these: + +- `Http.parseHead : List UInt8 → Option (Head × List UInt8)` reads a head and gives the octets after it. +- `Http.Head.print` writes a head. +- `Http.Head.framing : Head → Option Framing` gives the framing, or `none` when this library refuses the request. +- `Http.Re.isMatch` matches a string against a rule of the grammar. + +`SPEC.md` says what each one does. + +## What is proved + +The statements are in `Spec.lean`, and the proofs are in `Proofs/`. The statements use: +- the grammar, written rule for rule from the RFCs, in `Spec/Rules.lean`; +- the meaning of the grammar notation, in `Spec/Abnf.lean`; +- the other definitions, in `Spec/Defs.lean`; +- the types, in `Http/Types.lean` and `Http/Abnf.lean`. + +| Claim | Theorem | +|-------|---------| +| The matcher, by Brzozowski derivatives, decides exactly what a rule of the grammar notation matches. | `Spec.isMatch_iff` | +| `parseHead` reads exactly the request heads of the grammar, after any empty lines, and returns the head as written and the octets after it. A head is a request line `method SP request-target SP HTTP-version`, then field lines `field-name ":" OWS field-value OWS`, each ending in CRLF, then an empty line. The method and field names are tokens. The target is one of the four forms of RFC 9112 section 3.2, each in its RFC 3986 grammar, IPv6 literals included. Each value is a field value of RFC 9110 section 5.5. So it rejects a bare CR or LF, whitespace before a colon, a line that starts with whitespace (a folded line included), a CR, LF, NUL or any control octet other than HTAB in a value, and any other whitespace in the request line. HTAB may appear inside a value and in the optional whitespace around it. The request line and the field names hold no control octet. | `Spec.parseHead_iff` | +| A head prints as the grammar writes it, with one SP after each colon. | `Spec.print_eq` | +| Printing a head of the grammar, then reading it, gives it back, whatever follows it. | `Spec.parseHead_print` | +| `framing` gives a framing exactly when this library accepts the request by the rules below, and it is the framing they give. Only major version 1 is accepted. An HTTP/1.1 request, or a later 1.x, needs exactly one Host field, and any request at most one. Its value must be empty, or a host that is not empty with an optional port, so `Host: :80` and `Host: :` are refused: by RFC 9112 section 3.3 they give a target URI with an empty host, such as `http://:80/`, which RFC 9110 section 4.2.1 says a recipient "MUST reject it as invalid". For the same reason a target that begins with `:`, an authority-form target with an empty host such as `GET :80`, is refused with any method. A request whose method is exactly `CONNECT` needs the target `uri-host ":" port`, with a host that is not empty and a port from 1 to 65535, and no content: Transfer-Encoding, or a Content-Length that is not 0, is refused (RFC 9110, section 9.3.6: "A CONNECT request message does not have content"). With any other method, a target that starts with `http:` or `https:`, in any case, must be `( "http" / "https" ) "://" host [ ":" port ] path-abempty [ "?" query ]` where the host is not empty (RFC 9110, section 4.2). So it has an authority with no userinfo. Transfer-Encoding is accepted only in HTTP/1.1 or a later 1.x, without Content-Length, and only when its combined value is a list of the one coding `chunked`, in any case. The combined value is the values of all its field lines, joined with commas, and the list may have empty elements. Then the body is chunked. Content-Length is accepted only as one field line of digits, without Transfer-Encoding, and gives the length. With neither, the body has length 0. | `Spec.framing_iff` | +| A request with both Transfer-Encoding and Content-Length is rejected. | `Spec.framing_te_cl` | +| A request with two Content-Length field lines is rejected, even when they agree. | `Spec.framing_two_cl` | +| Test vectors, each with the answer `framing` gives. Accepted with no body: the examples of RFC 9112 sections 3.2.1 to 3.2.4, an HTTP/1.0 request with no Host, `CONNECT [::1]:65535`, `CONNECT http:80`, whose host is `http`, and `GET HTTP://a:/x`, with the scheme in upper case and an empty port. Accepted with a body: `Content-Length: 5` frames the five octets after the head, and `Transfer-Encoding: Chunked` is chunked. So are Transfer-Encoding lists with empty elements: `chunked,`, `, chunked`, and a `chunked` line with an empty Transfer-Encoding line, and `chunked` after a tab or two spaces. An empty Host value and `CONNECT a:443` with `Content-Length: 0` are accepted with no body. The classic shapes of request smuggling are rejected: two Content-Length values, Content-Length with Transfer-Encoding, `xchunked`, `chunked, identity`, `chunked, chunked`, `chunked;a=b`, a `chunked` line with a line of another coding, whitespace before a colon, a folded line, a bare LF, a bare CR, and Transfer-Encoding in HTTP/1.0. So are a missing Host and a repeated Host in HTTP/1.1, the Host values `:80` and `:`, a `CONNECT` with an empty port, port 0, port 65536, the target `/` or `:80`, or with content by `Content-Length: 5` or `Transfer-Encoding: chunked`, `GET :80` and `OPTIONS :`, and three `GET` targets: `http:` (no authority), `http:///a` (an empty host) and `https://u@a/` (userinfo). | `Spec.head_vectors` | + +The command-line tool in `Main.lean` calls these functions directly. + +## What is not proved + +- Reading requests and printing answers in `Main.lean`: the hex coding in `serve` mode, reading standard input in `check` mode, and the output and exit codes. The differential tests cover them, with malformed requests and CR LF line endings. +- The body. This library frames the body but does not read it. It does not decode chunked data, chunk extensions or trailers, and does not count the octets of a length-framed body. +- What a server does with a request it accepts: the meaning of the method, the target and the fields, routing by Host, and the response. +- Completeness against the RFCs. No theorem says that this library refuses every request the RFCs say a server must refuse. The statements are about its own rules, written from the RFCs, and `SPEC.md` says which of its refusals the RFCs require. What a server does after a refusal is also outside this library. For example, for an invalid Content-Length, RFC 9112 section 6.3 says "the server MUST respond with a 400 (Bad Request) status code and then close the connection". This library only decides that the request is refused. +- Repairs the RFC allows. Where RFC 9112 or RFC 9110 lets a recipient either reject or repair, this library always rejects. That covers a bare LF as a line end, a bare CR, whitespace before the first field line, a folded line, whitespace other than one SP in the request line, a NUL in a value, Transfer-Encoding with Content-Length, two Content-Length lines that agree, and a Content-Length list of equal values such as `5, 5`. A server that repairs these accepts requests that this one refuses. +- Transfer codings other than chunked. RFC 9112 allows `gzip, chunked`, for example. This library decodes no other coding, so it refuses a Transfer-Encoding that names another coding, as RFC 9112 section 6.1 lets a server do for a coding it does not understand. +- The pairing of method and target form. RFC 9112 says the authority-form is only used for CONNECT and the asterisk-form only for OPTIONS. Those are rules for senders, so this library accepts any other method with any form, except an authority-form target with an empty host, which it refuses whatever the method (see above and `SPEC.md`). RFC 9110 section 9.3.6 has one rule for servers: "A server MUST reject a CONNECT request that targets an empty or invalid port number". This library reads it as: a `CONNECT` must have the target `uri-host ":" port`, with a host that is not empty and a port from 1 to 65535, and no content (see `SPEC.md`). The method is case-sensitive, so `connect` is another method, and the rule does not apply to it. `a:1` fits both the absolute-form and the authority-form, and the head keeps the target as written. With a method other than `CONNECT`, `http:80` is held to the rule for http targets, so it is refused, though it also fits the authority-form. +- Percent-escapes in the target. A target may hold escaped octets such as `%0D%0A` or `%00`, as RFC 3986 allows, and the head keeps them as written. A proxy that decodes a target and writes it into another request must reject or re-escape them. Apache's mod_proxy, with some rewrite rules, did not (CVE-2023-25690). +- Limits on length. The grammar sets none, and neither does this library. A server should cap the size of a head before it reads it. +- Incomplete input. `parseHead` gives `none` both for a head that is not of the grammar and for one that has not fully arrived. It cannot tell a caller to wait for more octets. +- Speed. The code works on lists of octets, which suits proofs, not bulk data. The target and Host grammars are matched by derivatives, which is fast enough for heads of ordinary size. + +## What you must trust + +- The Lean kernel and the five external kernels shipped with Lean, which all check the proofs. +- `lake comparator`, which builds the statements and the proofs in a sandbox, exports them, and checks that each proof proves exactly its statement. +- bubblewrap and the Linux kernel's namespaces, which keep the untrusted build from tampering with that check. +- The Lean compiler, with the C compiler and linker shipped with it, and the runtime, which turn the proved definitions into the program that runs. +- Lean's core library, including the compiled code it puts in place of some definitions the proofs reason about (by `implemented_by` and `extern`), such as the arithmetic on natural numbers and on octets. +- The operating system and hardware it runs on. +- The transcription of the grammar in `Spec/Rules.lean`. A reviewer checks it against the RFCs rule by rule. The differential tests compare the code with a second transcription, the Python one, and check the IPv6 rule against Python's `ipaddress`. + +This project has no dependencies beyond Lean itself. + +## Other parsers + +`tests/CROSS-CHECK.md` records a one-off comparison with Node's built-in server, which uses llhttp in its default strict mode, with Go's `net/http` server, and with Python's `h11`. It is not part of the verified bar. + +This comparison was run before the rules for an empty host in authority-form and for CONNECT content were added, so on those inputs the verdicts it records for this project are the old ones. Each parser was sent all the heads in the first 6000 inputs of the differential tests. The other inputs are malformed requests to the tool. A parser accepts a head when it reads it and passes the request on. After a head this project accepts, the body it frames is sent: the whole body for a Content-Length up to 1,000,000, and a chunked body with 5 octets of data. After a head with a Content-Length above 1,000,000, no body is sent. `tests/CROSS-CHECK.md` records how many heads each parser gives the same verdict on, and that where both accept and the lengths can be compared, the body lengths agree every time. The lengths are not compared for heads with a Content-Length above 1,000,000, nor for CONNECT heads, where Node reads what follows as a tunnel. A CONNECT with content is now refused here, so that difference no longer gives a body to one parser and a tunnel to the other. + +The main differences are below. `tests/CROSS-CHECK.md` lists them all, with counts and examples. + +- **All three:** + - They accept a Host value with a bad IP literal, such as `Host: ::1`, and other Host values outside RFC 3986. RFC 9112 section 3.2 says a server MUST answer these with 400. + - They accept a CONNECT whose port is empty, 0 or above 65535, or whose target is not a host and port. RFC 9110 section 9.3.6 says a server MUST reject an empty or invalid port. Which ports are invalid is this library's reading. + - They accept a target with a bad IP literal, such as `http://[1::2::3]/`. RFC 9112 section 3 says a server SHOULD answer an invalid request line with 400 or 301. + - They accept Transfer-Encoding in HTTP/1.0, which RFC 9112 section 6.1 says a server MUST treat "as if the framing is faulty". + - They reject Transfer-Encoding lists with empty elements, such as `chunked,`. RFC 9110 section 5.6.1.2 says a recipient MUST accept them. + - They accept an `http` or `https` target with an empty host, such as `http://` or `http:///a`, which RFC 9110 sections 4.2.1 and 4.2.2 say a recipient that processes it MUST reject. They also accept one with userinfo, such as `http://u@a/`, which section 4.2.4 says a recipient SHOULD treat as an error. Go and h11 also accept one with no `//`, such as `http:`. Node rejects that, but it rejects every absolute-form target with no authority. +- **Node:** + - Repairs the RFC allows: other whitespace in the request line, such as `GET /a`, and a bare LF before the request line. + - It rejects requests the RFC says to accept: an absolute-form target with no authority, such as `x:`, or with a digit, `+`, `-` or `.` in its scheme (RFC 9112 section 3.2.2: a server MUST accept the absolute-form), and HTTP/1.2 to 1.9 (RFC 9110 section 6.2: SHOULD process it as 1.1). It also rejects a tab after a Content-Length or Transfer-Encoding value, though that tab is optional whitespace, not part of the value. + - It accepts requests the RFC says to refuse: two Host lines (RFC 9112 section 3.2, MUST), and `Transfer-Encoding:` with no coding, which it reads as no body (RFC 9112 section 6.3, MUST). + - Other choices: it rejects methods it does not know and the authority-form with a method other than CONNECT. It accepts HTTP/2.0 and `gzip, chunked`. +- **Go:** + - Repairs the RFC allows: a bare LF, a folded line, Transfer-Encoding with Content-Length, which it reads as chunked, and two equal Content-Length lines. + - It rejects requests the RFC says to accept: empty lines before the request line, even a single CRLF (RFC 9112 section 2.2: SHOULD ignore at least one), and a percent-escape of an ASCII octet in the host of the target, such as `%6C`. RFC 3986 allows that in a host name, and RFC 9112 section 3.2.2 says a server MUST accept the absolute-form. + - Other choices: it rejects the authority-form with a method other than CONNECT. +- **h11:** + - Repairs the RFC allows: a bare LF, a folded line, a Content-Length list of equal values such as `5, 5`, two equal Content-Length lines, and Transfer-Encoding with Content-Length, which it reads as chunked. + - It rejects requests the RFC says to accept: empty lines before the request line, even a single CRLF. + - It accepts requests the RFC says to refuse: no Host in HTTP/1.2 to 1.9. RFC 9112 section 3.2 requires a Host in HTTP/1.1, and RFC 9110 section 6.2 asks a server to handle a later 1.x as 1.1. + - Other choices: it accepts HTTP/2.0 and HTTP/0.9, a bad percent-escape such as `/%4g`, and control octets in a field line. + +## Re-check it + +Needs Linux, [elan](https://github.com/leanprover/elan), bubblewrap (`apt install bubblewrap`), and Python 3.11 or later. + +``` +lake build +lake comparator --paranoid +python3 tests/run_tests.py +``` + +`lake comparator --paranoid` builds the statements and the proofs in a sandbox. It checks that each theorem in `Proofs/` proves exactly the statement in `Spec.lean`, using only the axioms `propext`, `Classical.choice`, and `Quot.sound`, and replays it through every kernel shipped with Lean. + +The test script compares the tool with the rules of RFC 9112, RFC 9110 and RFC 3986, written again in the script, on inputs from a recorded seed. Besides valid and mutated heads, the inputs include `CONNECT` targets whose port is empty, 0, above 65535 or has leading zeros, `CONNECT` with content, authority-form targets with an empty host, Transfer-Encoding lists with empty elements on one line or several, IP literals that RFC 3986 does not allow, and http and https targets in any case. The script then rewrites `tests/TEST-RESULTS.md`, which records the counts. `tests/planted_bugs.py` plants small bugs in the code under proof, one at a time in a copy of the project, builds the tool, and runs the tests. `tests/PLANTED-BUGS.md` records which the tests catch, and why each one they do not catch changes nothing the tool prints. The cross-check, `python3 tests/cross_check.py`, also needs Node, Go, and `h11` in `.lake/oracle-packages` (`pip install --target .lake/oracle-packages h11`). + +## Layout + +- `Http/Types.lean`: the head, field and framing types. It is part of the specification. +- `Http/Abnf.lean`: the grammar notation, a small language of regular expressions over octets. It is part of the specification. +- `Http/Match.lean`, `Http/Grammar.lean`, `Http/Head.lean`, `Http/Framing.lean`: the code under proof. `Http/Grammar.lean` is the code's copy of the rules for the target, an http or https target, the Host value and a Transfer-Encoding list, which the proofs show equal to the spec's. +- `Spec.lean`: the statements, with `sorry` for proofs. A reviewer approves this file. +- `Spec/Abnf.lean`: what a rule of the notation matches. +- `Spec/Rules.lean`: the ABNF rules, from RFC 5234, RFC 9110, RFC 3986 and RFC 9112. +- `Spec/Defs.lean`: the text of a head, and the acceptance and framing rules, with the RFC text they come from and this library's choices. +- `Proofs.lean` and `Proofs/`: the proofs. +- `Main.lean`: the command-line tool. +- `lakefile.toml`: the build. It names the package, its version and license, its libraries and executable, and the default targets, and sets nothing else. +- `LICENSE`: the Apache License 2.0. +- `comparator.json`: which theorems `lake comparator` checks, and which axioms it allows. +- `bar.toml`: the record for the bar check: status, authors, approvals, and where things are. +- `SPEC.md`: the specification in plain words. +- `tests/run_tests.py`: the differential tests. `tests/TEST-RESULTS.md` is the record of their last run. +- `tests/planted_bugs.py`: plants small bugs in a copy of the code, one at a time, and runs the differential tests on each. `tests/PLANTED-BUGS.md` is its record. +- `tests/cross_check.py` and `tests/cross_check/`: the one-off comparison with Node, Go and h11. `tests/CROSS-CHECK.md` is its record. diff --git a/SPEC.md b/SPEC.md new file mode 100644 index 0000000..a33a2b5 --- /dev/null +++ b/SPEC.md @@ -0,0 +1,155 @@ +# Specification: http + +This library reads the head of an HTTP/1.1 request, decides whether to refuse the request, and gives how the body after the head is framed. Each refusal is either required by the RFCs or allowed by them and chosen here. The section "Which refusals the RFCs require" lists which is which. A reviewer who did not write this specification approves it. The approval also covers `Spec.lean`, `Spec/Abnf.lean`, `Spec/Rules.lean`, `Spec/Defs.lean`, `Http/Types.lean`, `Http/Abnf.lean`, and the other files `bar.toml` lists. + +Throughout, a message is a sequence of octets, as RFC 9112 section 2.2 requires: "A recipient MUST parse an HTTP message as a sequence of octets in an encoding that is a superset of US-ASCII". + +## The grammar + +The grammar is the ABNF of the RFCs, written in a small notation of regular expressions over octets (`Http/Abnf.lean`, with its meaning in `Spec/Abnf.lean`). `Spec/Rules.lean` writes each rule as the RFC does, in the RFC's order of alternatives: + +- RFC 5234: `ALPHA`, `DIGIT`, `HEXDIG`, `VCHAR`, `SP`, `HTAB`. +- RFC 9110: `tchar`, `token`, `OWS`, `obs-text`, `field-vchar`, `field-content`, `field-value`, `field-name`, `Content-Length`, `absolute-path`, `uri-host` and `Host`; `http-URI` and `https-URI` with a host that is not empty and no `userinfo` (sections 4.2.1, 4.2.2 and 4.2.4); and a list of one element as a recipient reads it (section 5.6.1.2). +- RFC 3986: `unreserved`, `pct-encoded`, `sub-delims`, `pchar`, `segment`, `query`, `scheme`, `userinfo`, `h16`, `dec-octet`, `IPv4address`, `ls32`, `IPv6address`, `IPvFuture`, `IP-literal`, `reg-name`, `host`, `port`, `authority`, the path rules, `hier-part` and `absolute-URI`. +- RFC 9112: `method`, `origin-form`, `absolute-form`, `authority-form`, `asterisk-form` and `request-target`. + +A quoted string in ABNF matches ASCII letters in either case (RFC 5234, section 2.3), so `"v"` in `IPvFuture` also matches `V`, and `HEXDIG` matches `a` to `f`. + +## The head + +RFC 9112 section 2.1 gives the message: + +``` +HTTP-message = start-line CRLF + *( field-line CRLF ) + CRLF + [ message-body ] +request-line = method SP request-target SP HTTP-version +HTTP-version = HTTP-name "/" DIGIT "." DIGIT +HTTP-name = %s"HTTP" +field-line = field-name ":" OWS field-value OWS +``` + +`parseHead` reads a head from the start of the input: the request line, the field lines and the empty line. It gives the head, and the octets after the empty line, which are the start of the body or of the next request. The head keeps: +- the method, the target and each field name and value as written; +- the two digits of the version as numbers; +- the fields in order. + +A field's value does not include the optional whitespace around it (section 5.1). + +- Before the request line, any number of empty lines are skipped, as section 2.2 asks: a server "SHOULD ignore at least one empty line (CRLF) received prior to the request-line". +- Every line ends in CRLF. A field value cannot hold a CR, LF, NUL or any control octet other than HTAB. HTAB may appear inside a value and in the optional whitespace around it. The request line and the field names hold no control octet. So `parseHead` rejects: + - a bare CR, or a bare LF as a line end; + - a line starting with whitespace, which is how both whitespace after the request line and a folded line (`obs-fold`) begin; + - whitespace before a colon; + - any separator in the request line other than one SP. +- The target is one of the four forms of section 3.2: + - `origin-form`, a path with an optional query; + - `absolute-form`, an absolute URI; + - `authority-form`, a host and port; + - `asterisk-form`, `*`. + + Each form is in its RFC 3986 grammar, with percent-escapes of two hex digits, and IPv6 and IPvFuture literals. A fragment (`#`) is not part of any form. The head keeps percent-escapes as written and does not decode them. + +RFC 9112 allows a recipient to repair some of these instead of rejecting them. Section 2.2 allows a single LF as a line end, and a bare CR replaced by SP. Section 3 allows parsing the request line on other whitespace. Section 5.2 allows a folded line to be replaced by SP. This library takes none of those choices: it rejects. Section 5.1 leaves no choice for whitespace before a colon: "A server MUST reject ... any received request message that contains whitespace between a header field name and colon". + +`Head.print` writes a head back, with one SP after each colon, as section 5.1 prefers. + +## Accepting a request, and framing its body + +`Head.framing` gives the framing of the body after the head: a length in octets, which is 0 for no body, or the chunked coding. It gives `none` when this library refuses the request. `Spec.Accepts` in `Spec/Defs.lean` states the rules below, and `Spec.framing_iff` says that `Head.framing` follows them. Field names are compared without regard to ASCII case (RFC 9110, section 5.1). + +- **The version:** only major version 1 is accepted. RFC 9110 section 6.2 lets a server refuse other major versions with 505. A minor version of 1 or more is handled as 1.1, as section 6.2 asks of a version higher than the recipient implements. +- **Host:** a request with more than one Host field line is refused. So is a request with a minor version of 1 or more and no Host line (RFC 9112, section 3.2). A Host value must be empty, or a host that is not empty with an optional port: `[ hostNonEmpty [ ":" port ] ]` (`Spec.hostField`). So `Host: :80` and `Host: :` are refused, though `uri-host [ ":" port ]` allows them, since `reg-name` may be empty. The reason is RFC 9112 section 3.3: for a target that is not in absolute-form, the server builds the target URI from the scheme, "://", and the Host value as its authority. `GET /` with `Host: :80` has the target URI `http://:80/`, with an empty host, and RFC 9110 section 4.2.1 says a recipient that processes such a URI "MUST reject it as invalid". An empty Host value is different. RFC 9112 section 3.2 tells a client to send one when the target URI has no authority, and section 3.3 says the server "can reject the request or determine whether a configured default applies". This library accepts it and leaves that choice to the server. +- **An empty host in authority-form:** a target that begins with `:` is refused, whatever the method. In a `request-target` that is exactly an authority-form target with an empty host, such as `:80` or `:`: origin-form begins with `/`, absolute-form with a scheme, which begins with a letter, and asterisk-form is `*`. RFC 9112 section 3.3 says "If the request-target is in authority-form, the target URI's authority component is the request-target", for any method. So `GET :80` has the target URI `http://:80`, with an empty host, which RFC 9110 section 4.2.1 says a recipient "MUST reject". `Spec.AuthorityHostOK` states this. +- **CONNECT:** when the method is `CONNECT`, the target must be `uri-host ":" port` with a host that is not empty (by the rule above), and the port, read as a decimal number, must be from 1 to 65535. Leading zeros are allowed, so `a:00080` is port 80. An empty port is refused, and so is a target that is not a host and port, such as `/` or `*`. RFC 9110 section 9.3.6 says "A server MUST reject a CONNECT request that targets an empty or invalid port number". It does not say which port numbers are invalid. Here a valid one is from 1 to 65535: a TCP port number is 16 bits (RFC 9293, section 3.1), and 0 is a Reserved port number (RFC 6335, section 6). A server need not accept CONNECT at all ("An origin server MAY accept a CONNECT request"), so refusing port 0 is allowed however "invalid" is read. The method is compared as written, since "The method token is case-sensitive" (section 9.1). So `connect` is another method, and this rule does not apply to it. +- **CONNECT has no content:** a `CONNECT` with Transfer-Encoding, or with a Content-Length that is not 0, is refused (`Spec.ConnectNoContent`). RFC 9110 section 9.3.6 says "A CONNECT request message does not have content". Read alone, RFC 9112 section 6.3 would frame a body after such a head, and parsers differ on those octets: Go reads them as a body, and Node passes them to the tunnel. Refusing the request removes that difference. A server need not accept CONNECT at all (section 9.3.6: "An origin server MAY accept a CONNECT request"). `Content-Length: 0` is accepted, since it frames no content. +- **http and https targets:** when the method is not exactly `CONNECT` and the target starts with `http:` or `https:`, in any case, the target must match + + ``` + ( "http" / "https" ) "://" host [ ":" port ] path-abempty [ "?" query ] + ``` + + where the `host` is not empty. That is an `http-URI` or `https-URI` (RFC 9110, sections 4.2.1 and 4.2.2) with no `userinfo` in its authority. Of the three kinds of `host`, only `reg-name` can be empty, so `Spec.hostNonEmpty` in `Spec/Rules.lean` is `host` with the `*` of `reg-name` made `1*`. The scheme may be in any case, since "schemes are case-insensitive" (RFC 3986, section 3.1). Sections 4.2.1 and 4.2.2 say of an http or https URI with an empty host: "A recipient that processes such a URI reference MUST reject it as invalid". Section 4.2.4 says "a recipient SHOULD parse for userinfo and treat its presence as an error". So these are refused: + - an empty host, such as `http://`, `http:///a` or `https://:443/`; + - userinfo, such as `https://u@a/`, or the empty userinfo of `http://@a/`; + - no authority, such as `http:` or `http:/a`. That is not an `http-URI` or `https-URI` at all, since both need `"://" authority`. + + An empty port is allowed, since "If the port subcomponent is empty or not given, TCP port 80 (the reserved port for WWW services) is the default" (section 4.2.1), and section 4.2.2 says the same of port 443. So `HTTP://a:/x` is accepted. A CONNECT target is not a URI. It consists "of only the host and port number of the tunnel destination" (section 9.3.6), so this rule does not apply to it: `CONNECT http:80` names the host `http` and the port 80. The method is compared as written here too, so `connect http:80` is held to this rule, and refused. With any method other than `CONNECT`, `http:80` is refused, though it also fits the authority-form. +- **Transfer-Encoding:** all its field lines are read as one value. That combined field value is their values in order, joined with commas (RFC 9110, section 5.2). Transfer-Encoding is accepted only when the combined value is a list of the one coding `chunked`, in any case, in a request with a minor version of 1 or more and no Content-Length. Then the body is chunked. The list may have empty elements, which "do not contribute to the count of elements present", and RFC 9110 section 5.6.1.2 says a recipient MUST accept such lists. So the value must match `*( OWS "," OWS ) "chunked" *( OWS "," OWS )`. For example, `chunked,` and `, chunked` are chunked, and so is a `chunked` line together with an empty Transfer-Encoding line. Every other use is refused: + - Transfer-Encoding with Content-Length. Section 6.1 lets a server refuse it: "A server MAY reject a request that contains both Content-Length and Transfer-Encoding". + - Transfer-Encoding in HTTP/1.0, which section 6.1 says must be treated "as if the framing is faulty". + - A value with no coding, such as an empty value or `,`, or with chunked not last, such as `xchunked` or `chunked, identity`. Section 6.3 says that then "the server MUST respond with the 400 (Bad Request) status code". + - Chunked twice, such as `chunked, chunked`, or `chunked` on two lines. Section 6.1 says "A sender MUST NOT apply the chunked transfer coding more than once", and RFC 9110 section 15.5.1 lets a server answer "invalid request message framing" with 400. + - Another coding before chunked, such as `gzip, chunked`. This library does not understand that coding, and section 6.1 says a server that receives "a transfer coding it does not understand SHOULD respond with 501". +- **Content-Length:** with no Transfer-Encoding, it must be one field line whose value is `1*DIGIT` (RFC 9110, section 8.6). Then the body has that many octets. Section 6.3 lets a recipient accept a list of equal values such as `5, 5`. This library refuses it, and refuses two Content-Length lines even when they agree. +- **Neither field:** the body has length 0, by section 6.3: "If this is a request message and none of the above are true, then the message body length is zero". + +## Which refusals the RFCs require + +Each kind of request this library refuses is in one of two groups. + +Refusals the RFCs require: +- whitespace before a colon (RFC 9112, section 5.1); +- no Host line in a request with a minor version of 1 or more, two Host lines, or a Host value that is not of the grammar (RFC 9112, section 3.2). The RFC says this of HTTP/1.1, and a later 1.x is handled as 1.1 here; +- a Host value with an empty host before a colon, such as `:80` or `:`, and an authority-form target with an empty host, such as `GET :80` or `CONNECT :80`, whatever the method. By RFC 9112 section 3.3, each gives a target URI with an empty host, such as `http://:80/`, and RFC 9110 section 4.2.1 says a recipient that processes such a URI "MUST reject it as invalid". This is this library's reading of the two sections together. An empty Host value is not refused: section 3.3 lets a server reject it or use a configured default, and this library leaves that to the server; +- a `CONNECT` whose target is not a host and port, or whose port is empty or above 65535. That is this library's reading of "an empty or invalid port number" (RFC 9110, section 9.3.6). A server need not accept CONNECT at all, so these refusals are allowed however that is read; +- an `http` or `https` target with an empty host, such as `http://` or `http:///a`, when the method is not `CONNECT` (RFC 9110, sections 4.2.1 and 4.2.2: a recipient that processes such a URI "MUST reject it as invalid"); +- Transfer-Encoding with no coding, or with chunked not last (RFC 9112, section 6.3); +- Transfer-Encoding in HTTP/1.0, which section 6.1 says a server MUST treat "as if the framing is faulty"; +- a Content-Length that is not digits, with no Transfer-Encoding, such as `+5` or `5, 6`, or two lines `5` and `6` (RFC 9112, section 6.3: "the recipient MUST treat it as an unrecoverable error"). + +Refusals the RFCs allow, chosen here: +- a bare CR or LF, whitespace before the first field line, other whitespace in the request line, and a folded line, which RFC 9112 sections 2.2, 3 and 5.2 let a recipient repair instead; +- a NUL in a field value, which RFC 9110 section 5.5 lets a recipient replace with SP, and any other control octet but HTAB, which that section calls invalid but lets a recipient keep in a safe context; +- any other head that is not of the grammar, such as one with a target outside RFC 3986. For these RFC 9112 section 2.2 says a server "SHOULD respond with a 400 (Bad Request) response"; +- a major version other than 1 (RFC 9110, section 6.2: a server "can send a 505"); +- Transfer-Encoding with Content-Length (RFC 9112, section 6.1: "MAY reject"); +- two Content-Length lines that agree, or a list of equal values such as `5, 5` (RFC 9110, section 8.6: a recipient "MAY either reject the message as invalid or replace" the value); +- chunked twice, which a sender must not send (RFC 9112, section 6.1); +- a coding other than chunked, which this library does not understand (RFC 9112, section 6.1: "SHOULD respond with 501"); +- a `CONNECT` with port 0, a Reserved port number (RFC 6335, section 6), since a server need not accept CONNECT; +- a `CONNECT` with Transfer-Encoding or a Content-Length that is not 0. RFC 9110 section 9.3.6 says such a request "does not have content", and a server need not accept CONNECT; +- `chunked` with a parameter, such as `chunked;a=b`. RFC 9112 section 7.1 says "The chunked coding does not define any parameters. Their presence SHOULD be treated as an error"; +- an `http` or `https` target with userinfo, such as `https://u@a/` (RFC 9110, section 4.2.4: a recipient "SHOULD parse for userinfo and treat its presence as an error"); +- a target with the scheme http or https but no authority, such as `http:` or `http:/a`. It fits `absolute-URI`, but it is not an `http-URI` or `https-URI` at all, and RFC 3986 section 3.1 says that a URI that "violates one or more scheme-specific restrictions" should be flagged "as an error". + +No theorem says that this library refuses every request the RFCs require a server to refuse. The statements are about its own rules, and the lists above are this specification's reading of the RFCs. What a server does after a refusal is also outside this library. For example, for an invalid Content-Length, RFC 9112 section 6.3 says "the server MUST respond with a 400 (Bad Request) status code and then close the connection". This library only decides that the request is refused. + +## Errors + +`parseHead` returns `none` for any input that does not start with a complete head of the grammar. That includes input that ends before the empty line. `Head.framing` returns `none` for a request this library refuses. No function can fail any other way. + +## The command-line tool + +The command-line tool in `Main.lean` has two modes: + +- `httphead check` reads a request on standard input. It prints the request line, each field and the framing: `length N`, `chunked` or `reject`. It prints `invalid` for input with no head of the grammar. It exits with 0 only for a request this library accepts. +- `httphead serve` answers requests from the differential tests, one per line, with octets sent as hex digits. The header comment of `Main.lean` gives the protocol. + +Every answer comes from `parseHead`, `Head.print` and `Head.framing`. + +## What must always hold + +Each property is a theorem in `Spec.lean`, under the name given. + +| Property | Theorem | +|----------|---------| +| `isMatch` decides `Spec.Matches`, what a rule of the notation matches. | `Spec.isMatch_iff` | +| `parseHead bs` is `(h, rest)` exactly when `h` is a head of the grammar and `bs` is empty lines, then `h` as written with any optional whitespace around its values, then `rest`. | `Spec.parseHead_iff` | +| `Head.print` writes the head as `Spec.render` gives it. | `Spec.print_eq` | +| For a head of the grammar, reading what `Head.print` wrote gives the head back, whatever follows it. | `Spec.parseHead_print` | +| `Head.framing h` is `some fr` exactly when `Spec.Accepts h fr`: the version, the Host rule, the CONNECT rule, the rule for http and https targets, the empty-host rule for authority-form targets, no content for CONNECT, and the framing rules above. | `Spec.framing_iff` | +| Transfer-Encoding with Content-Length is refused. | `Spec.framing_te_cl` | +| Two Content-Length field lines are refused. | `Spec.framing_two_cl` | +| The examples of RFC 9112 sections 3.2.1 to 3.2.4 are accepted, with no body, and so are an HTTP/1.0 request with no Host, `CONNECT [::1]:65535`, `CONNECT http:80` and `GET HTTP://a:/x`. So are an empty Host value and `CONNECT a:443` with `Content-Length: 0`. A length and a chunked body are framed. Transfer-Encoding lists with empty elements, on one line or two, are chunked, and so is `chunked` after a tab or two spaces. The shapes of request smuggling are refused, and so is `chunked;a=b`. Also refused: a missing or repeated Host in HTTP/1.1; the Host values `:80` and `:`; a `CONNECT` with an empty port, port 0, port 65536, the target `/` or `:80`, or with content by `Content-Length: 5` or `Transfer-Encoding: chunked`; `GET :80` and `OPTIONS :`; and the targets `http:`, `http:///a` and `https://u@a/`. | `Spec.head_vectors` | + +Together, these fix every output. + +- `parseHead` is fixed for every input. The head of the grammar at its start, if any, is unique: each line ends at the first CRLF, the request line splits at its two SPs, and a field line splits at its first colon. +- `Head.print` is fixed for every head, and `Head.framing` for every head. +- A parser that accepted nothing would fail `Spec.parseHead_print`, and one that accepted too much would fail `Spec.parseHead_iff`. + +## Oracle + +The differential tests compare the tool with the grammar and rules above, written again in Python from the RFCs, with the choices of this specification. They are regular expressions for the request line, the field lines and the four target forms, then the Host rule, the CONNECT rule, the rule for http and https targets and the framing rules. As here, the Transfer-Encoding lines are read as one list. The rule for http and https targets is written another way than `Spec.httpTarget`: it ends the authority at the first `/`, `?` or `#`, as RFC 3986 section 3.2 says, then looks for an `@` and for an empty host. The inputs come from a recorded seed. Besides valid and mutated heads, they include `CONNECT` targets whose port is empty, 0, above 65535 or has leading zeros, `CONNECT` with Content-Length or Transfer-Encoding, authority-form targets with an empty host, the other methods `connect` and `Connect`, http and https targets in any case with a host, an empty host, no `//`, userinfo or an empty port, targets of other schemes such as `httpx` and `ws`, `CONNECT` targets that name the host http or https, Transfer-Encoding lists with empty elements on one line or several, IP literals that RFC 3986 does not allow, and every input of `Spec.head_vectors`. The Python IPv6 rule is itself checked against Python's `ipaddress` module on generated addresses. `tests/TEST-RESULTS.md` has the record of the last run, with its counts. diff --git a/Spec.lean b/Spec.lean new file mode 100644 index 0000000..0f09f34 --- /dev/null +++ b/Spec.lean @@ -0,0 +1,169 @@ +/- + The statements: what the code in `Http/` must do. A reviewer approves + this file, with the definitions in `Spec/` and the types in + `Http/Types.lean` and `Http/Abnf.lean`. Each `sorry` here is proved in + `Proofs/`, and `lake comparator` checks that each proof proves + exactly the statement here. +-/ + +import Http +import Spec.Abnf +import Spec.Rules +import Spec.Defs + +open Http + +/-! ## The grammar notation -/ + +/-- The matcher decides what a rule matches. -/ +theorem Spec.isMatch_iff (r : Re) (s : List UInt8) : r.isMatch s = true ↔ Spec.Matches r s := sorry + +/-! ## The head -/ + +/-- `parseHead` reads exactly the request heads of the grammar of + RFC 9112, RFC 9110 and RFC 3986, after any empty lines, with the choices in + `Spec/Defs.lean`, and returns the head as written and the octets + after it. -/ +theorem Spec.parseHead_iff (bs : List UInt8) (h : Head) (rest : List UInt8) : + parseHead bs = some (h, rest) ↔ Spec.Reads bs h rest := sorry + +/-- A head prints as the grammar writes it, with one SP after each + colon. -/ +theorem Spec.print_eq (h : Head) : h.print = Spec.render h := sorry + +/-- Round trip: printing a head of the grammar, then parsing it, gives + it back, whatever follows it. -/ +theorem Spec.parseHead_print (h : Head) (rest : List UInt8) (hv : Spec.HeadValid h) : + parseHead (h.print ++ rest) = some (h, rest) := sorry + +/-! ## Acceptance and framing -/ + +/-- `framing` decides which heads this library accepts, by the version, + the Host rule of RFC 9112 section 3.2, the CONNECT rule of RFC 9110 + section 9.3.6, the rule of RFC 9110 section 4.2 for http and https + targets, and RFC 9112 section 6.3 with the choices in + `Spec/Defs.lean`, and how it frames the body. -/ +theorem Spec.framing_iff (h : Head) (fr : Framing) : h.framing = some fr ↔ Spec.Accepts h fr := sorry + +/-- A head with both Transfer-Encoding and Content-Length is rejected. -/ +theorem Spec.framing_te_cl (h : Head) (hte : Spec.named h "transfer-encoding" ≠ []) + (hcl : Spec.named h "content-length" ≠ []) : h.framing = none := sorry + +/-- A head with two Content-Length field lines is rejected, even when + they agree. -/ +theorem Spec.framing_two_cl (h : Head) (h2 : 2 ≤ (Spec.named h "content-length").length) : + h.framing = none := sorry + +/-- Test vectors, each with the answer `framing` gives. + - Accepted, with no body: the examples of RFC 9112 sections 3.2.1 to + 3.2.4, an HTTP/1.0 request with no Host, an empty Host value, + `CONNECT [::1]:65535`, `CONNECT http:80` (the host `http`), and + `HTTP://a:/x` (a scheme in upper case and an empty port). + - Accepted with a body: `Content-Length: 5`, and Transfer-Encoding + lists of the one coding `chunked`, in any case, with empty + elements, which RFC 9110 section 5.6.1.2 says a recipient must + accept, and after a tab or more than one space. + - Rejected, the classic shapes of request smuggling: two + Content-Length values, Content-Length with Transfer-Encoding, a + Transfer-Encoding value other than a list of the one coding + `chunked`, chunked twice, two Transfer-Encoding lines that list + another coding, `chunked` with a parameter, whitespace before a + colon, a folded line, a bare LF, a bare CR, and Transfer-Encoding + in HTTP/1.0. + - Rejected too: an HTTP/1.1 request with no Host or with two; a Host + value with an empty host, `:80` or `:`; a CONNECT with an empty + port, port 0, a port above 65535, an empty host, or a target that + is not a host and port; a CONNECT with content, by Content-Length + or Transfer-Encoding (a CONNECT with `Content-Length: 0` is + accepted); an authority-form target with an empty host for any + method, `GET :80` and `OPTIONS :`; and an http or https target with + no authority, an empty host or userinfo. -/ +theorem Spec.head_vectors : + -- Sections 3.2.1 to 3.2.4 + (parseHead (Spec.ascii "GET /where?q=now HTTP/1.1\r\nHost: www.example.org\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii + "GET http://www.example.org/pub/WWW/TheProject.html HTTP/1.1\r\nHost: www.example.org\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "CONNECT www.example.com:80 HTTP/1.1\r\nHost: www.example.com\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "OPTIONS * HTTP/1.1\r\nHost: www.example.org:8001\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- A body framed by length and by chunked coding + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\n\r\nhello")).map + (fun p => (p.1.framing, p.2)) = some (some (.length 5), Spec.ascii "hello") ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: Chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Lists with empty elements (RFC 9110, section 5.6.1.2) + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: , chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding:\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Optional whitespace before the value: a tab, and two spaces + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\tchunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = some .chunked ∧ + -- Smuggling shapes + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 6\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: xchunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, identity\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked;a=b\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii + "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding: x\r\n\r\n")).bind + (·.1.framing) = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding : chunked\r\n\r\n") = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\r\nX: y\r\n Transfer-Encoding: chunked\r\n\r\n") = + none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\nTransfer-Encoding: chunked\r\n\r\n") = none ∧ + parseHead (Spec.ascii "POST /a HTTP/1.1\r\nHost: x\rTransfer-Encoding: chunked\r\n\r\n") = none ∧ + (parseHead (Spec.ascii "POST /a HTTP/1.0\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + -- The Host rule + (parseHead (Spec.ascii "GET / HTTP/1.1\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: a\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.0\r\n\r\n")).bind (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost:\r\n\r\n")).bind (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: :80\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET / HTTP/1.1\r\nHost: :\r\n\r\n")).bind (·.1.framing) = none ∧ + -- The CONNECT rule (RFC 9110, section 9.3.6) + (parseHead (Spec.ascii "CONNECT a: HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:0 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:65536 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT / HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT :80 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT [::1]:65535 HTTP/1.1\r\nHost: a\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- A CONNECT has no content (RFC 9110, section 9.3.6) + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 5\r\n\r\nhello")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked\r\n\r\n")).bind + (·.1.framing) = none ∧ + (parseHead (Spec.ascii "CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 0\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + -- An authority-form target with an empty host, for any method (RFC 9112, section 3.3) + (parseHead (Spec.ascii "GET :80 HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "OPTIONS : HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + -- http and https targets (RFC 9110, sections 4.2.1, 4.2.2 and 4.2.4) + (parseHead (Spec.ascii "GET http: HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET http:///a HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET https://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n")).bind (·.1.framing) = none ∧ + (parseHead (Spec.ascii "GET HTTP://a:/x HTTP/1.1\r\nHost: a\r\n\r\n")).bind + (·.1.framing) = some (.length 0) ∧ + (parseHead (Spec.ascii "CONNECT http:80 HTTP/1.1\r\nHost: http\r\n\r\n")).bind + (·.1.framing) = some (.length 0) := sorry diff --git a/Spec/Abnf.lean b/Spec/Abnf.lean new file mode 100644 index 0000000..b3fc2be --- /dev/null +++ b/Spec/Abnf.lean @@ -0,0 +1,21 @@ +/- + What a rule of the grammar notation in `Http/Abnf.lean` matches. Part + of the approved specification, with `Spec.lean`. +-/ + +import Http.Abnf + +open Http + +/-- The strings each rule matches, by the usual meaning of each form of + regular expression. -/ +inductive Spec.Matches : Re → List UInt8 → Prop where + | eps : Spec.Matches .eps [] + | range {lo hi c : UInt8} : lo ≤ c → c ≤ hi → Spec.Matches (.range lo hi) [c] + | cat {a b : Re} {s t : List UInt8} : + Spec.Matches a s → Spec.Matches b t → Spec.Matches (.cat a b) (s ++ t) + | altL {a b : Re} {s : List UInt8} : Spec.Matches a s → Spec.Matches (.alt a b) s + | altR {a b : Re} {s : List UInt8} : Spec.Matches b s → Spec.Matches (.alt a b) s + | starNil {a : Re} : Spec.Matches (.star a) [] + | starCons {a : Re} {s t : List UInt8} : + Spec.Matches a s → Spec.Matches (.star a) t → Spec.Matches (.star a) (s ++ t) diff --git a/Spec/Defs.lean b/Spec/Defs.lean new file mode 100644 index 0000000..2f0b60f --- /dev/null +++ b/Spec/Defs.lean @@ -0,0 +1,306 @@ +/- + The definitions the statements use: the text of a request head, and + the rules of RFC 9112 and RFC 9110 for which requests this library + accepts and how the body that follows the head is framed. Part of the + approved specification, with `Spec.lean`, and written from the RFCs, + independently of the code in `Http/`. +-/ + +import Http.Types +import Spec.Abnf +import Spec.Rules + +open Http + +/-! ## Octets -/ + +/-- The octets of an ASCII string. -/ +def Spec.ascii (s : String) : List UInt8 := s.toList.map fun c => c.toNat.toUInt8 + +/-- `CRLF = CR LF ; Internet standard newline` (RFC 5234, Appendix B.1). -/ +def Spec.crlf : List UInt8 := [0x0D, 0x0A] + +/-- The octet of a decimal digit. -/ +def Spec.digit (n : Nat) : UInt8 := (0x30 + n).toUInt8 + +/-! ## The head + +RFC 9112, section 2.1: + +``` +HTTP-message = start-line CRLF + *( field-line CRLF ) + CRLF + [ message-body ] +``` + +and for a request, `start-line` is `request-line` (section 3): + +``` +request-line = method SP request-target SP HTTP-version +HTTP-version = HTTP-name "/" DIGIT "." DIGIT +HTTP-name = %s"HTTP" +field-line = field-name ":" OWS field-value OWS +``` + +Section 5.1: "The field line value does not include that leading or +trailing whitespace". Section 2.2: "a server that is expecting to +receive and parse a request-line SHOULD ignore at least one empty line +(CRLF) received prior to the request-line"; here any number of them is +ignored. + +Where RFC 9112 lets a recipient choose to repair a message, the head +here does not allow it, and so it is rejected: +- "a recipient MAY recognize a single LF as a line terminator" + (section 2.2): only CRLF ends a line here; +- "A recipient of such a bare CR MUST consider that element to be + invalid or replace each bare CR with SP" (section 2.2); +- "A recipient that receives whitespace between the start-line and the + first header field MUST either reject the message as invalid or + consume each whitespace-preceded line" (section 2.2); +- "recipients MAY instead parse on whitespace-delimited word boundaries" + in the request line (section 3); +- obs-fold: "MUST either reject the message by sending a 400 (Bad + Request) ... or replace each received obs-fold with one or more SP + octets" (section 5.2). + +None of these fit the grammar: a field line cannot begin with +whitespace, and a field value holds no CR, LF or NUL. Section 5.1 leaves +no choice: "A server MUST reject ... any received request message that +contains whitespace between a header field name and colon". +-/ + +/-- The request line of a head. -/ +def Spec.requestLine (h : Head) : List UInt8 := + h.method ++ [0x20] ++ h.target ++ [0x20] ++ Spec.ascii "HTTP/" ++ + [Spec.digit h.major, 0x2E, Spec.digit h.minor] + +/-- A field line's name is a `field-name` and its value a `field-value`. -/ +def Spec.FieldValid (f : Field) : Prop := + Spec.Matches Spec.fieldName f.name ∧ Spec.Matches Spec.fieldValue f.value + +/-- A head of the grammar: the method is a `method`, the target a + `request-target`, each version number a `DIGIT`, and each field + valid. -/ +def Spec.HeadValid (h : Head) : Prop := + Spec.Matches Spec.method h.method ∧ Spec.Matches Spec.requestTarget h.target ∧ + h.major ≤ 9 ∧ h.minor ≤ 9 ∧ ∀ f ∈ h.fields, Spec.FieldValid f + +/-- `t` is a field line for `f`: `field-name ":" OWS field-value OWS`. -/ +def Spec.FieldLineText (f : Field) (t : List UInt8) : Prop := + ∃ w1 w2, Spec.Matches Spec.OWS w1 ∧ Spec.Matches Spec.OWS w2 ∧ + t = f.name ++ [0x3A] ++ w1 ++ f.value ++ w2 + +/-- `t` is a field line for each field in order, each with its CRLF, + then the empty line. -/ +def Spec.FieldsText : List Field → List UInt8 → Prop + | [], t => t = Spec.crlf + | f :: fs, t => ∃ l t', Spec.FieldLineText f l ∧ Spec.FieldsText fs t' ∧ t = l ++ Spec.crlf ++ t' + +/-- `t` is the head `h` as written: its request line and CRLF, then its + fields and the empty line. -/ +def Spec.HeadText (h : Head) (t : List UInt8) : Prop := + ∃ t', Spec.FieldsText h.fields t' ∧ t = Spec.requestLine h ++ Spec.crlf ++ t' + +/-- `bs` begins with the head `h`, after any number of empty lines, and + `rest` follows it. -/ +def Spec.Reads (bs : List UInt8) (h : Head) (rest : List UInt8) : Prop := + Spec.HeadValid h ∧ + ∃ k t, Spec.HeadText h t ∧ bs = (List.replicate k Spec.crlf).flatten ++ t ++ rest + +/-- The head as a sender writes it, with one SP after each colon, as + section 5.1 prefers. -/ +def Spec.render (h : Head) : List UInt8 := + Spec.requestLine h ++ Spec.crlf ++ + (h.fields.map fun f => f.name ++ [0x3A, 0x20] ++ f.value ++ Spec.crlf).flatten ++ Spec.crlf + +/-! ## Which requests are accepted, and their framing + +RFC 9110, section 5.1: "Field names are case-insensitive." + +RFC 9110, section 6.2: "A server can send a 505 (HTTP Version Not +Supported) response if it wishes, for any reason, to refuse service of +the client's major protocol version", and "A recipient that receives a +message with a major version number that it implements and a minor +version number higher than what it implements SHOULD process the +message as if it were in the highest minor version within that major +version to which the recipient is conformant". Here only major version +1 is accepted, and a minor version of 1 or more is handled as 1.1. + +RFC 9112, section 3.2: "A server MUST respond with a 400 (Bad Request) +status code to any HTTP/1.1 request message that lacks a Host header +field and to any request message that contains more than one Host header +field line or a Host header field with an invalid field value." + +RFC 9110, section 9.3.6: "CONNECT uses a special form of request +target, unique to this method, consisting of only the host and port +number of the tunnel destination, separated by a colon", and "A server +MUST reject a CONNECT request that targets an empty or invalid port +number". Section 9.1: "The method token is case-sensitive", so the +method is compared as written. The RFC does not say which port numbers +are invalid. Here a valid one is from 1 to 65535: a TCP port number is +16 bits (RFC 9293, section 3.1), and 0 is a Reserved port number (RFC +6335, section 6). A server need not accept CONNECT at all (section +9.3.6: "An origin server MAY accept a CONNECT request"), so refusing +port 0 is allowed however "invalid" is read. + +RFC 9110, sections 4.2.1 and 4.2.2: "A sender MUST NOT generate an +"http" URI with an empty host identifier. A recipient that processes +such a URI reference MUST reject it as invalid", and the same for +"https". Section 4.2.4: "a recipient SHOULD parse for userinfo and treat +its presence as an error". So a target whose scheme is http or https, in +any case (RFC 3986, section 3.1: "schemes are case-insensitive"), must +be an `http-URI` or `https-URI` with a host that is not empty and no +userinfo. A CONNECT target is in authority-form, `uri-host ":" port`, +which has no scheme, so this rule does not apply to it: `CONNECT +http:80` names the host `http`. + +RFC 9112, section 3.3: for a target that is not in absolute-form, the +server builds the target URI by "concatenating the scheme, "://", +authority, and combined path and query component". "If the +request-target is in authority-form, the target URI's authority +component is the request-target. Otherwise, the target URI's authority +component is the field value of the Host header field." The scheme is +http or https unless the server's configuration or a trusted gateway +gives another, and this library has neither. So `GET /` with `Host: :80` +has the target URI `http://:80/`, and `CONNECT :80` has `http://:80`. +Both have an empty host, which sections 4.2.1 and 4.2.2 say a recipient +must reject. So here a Host value and a CONNECT target must have a host +that is not empty. An empty Host value is still accepted. Section 3.2 +says "If the authority component is missing or undefined for the target +URI, then a client MUST send a Host header field with an empty field +value", and section 3.3 says that then "the server can reject the +request or determine whether a configured default applies". + +The same section gives the target URI of an authority-form target for +any method, not only CONNECT: "If the request-target is in +authority-form, the target URI's authority component is the +request-target". So `GET :80` and `OPTIONS :` also have a target URI +with an empty host, and are refused. In a `request-target`, a target +that begins with `:` is exactly such a target: origin-form begins with +`/`, absolute-form with a scheme, which begins with ALPHA, and +asterisk-form is `*`. + +RFC 9110, section 9.3.6: "A CONNECT request message does not have +content." RFC 9112 section 6.3 would give a CONNECT with Content-Length +or Transfer-Encoding a body, and parsers differ on what they do with +those octets: some read them as a body, others pass them to the tunnel. +Here a CONNECT with Transfer-Encoding, or with a Content-Length that is +not 0, is refused. A server need not accept CONNECT at all (section +9.3.6: "An origin server MAY accept a CONNECT request"). + +RFC 9110, section 5.2: when a field name is repeated, "its combined +field value consists of the list of corresponding field line values +within that section, concatenated in order, with each field line value +separated by a comma". + +RFC 9112, section 6.3, for a request, with this library's choices where +the RFC gives one: +- "If a message is received with both a Transfer-Encoding and a + Content-Length header field ... Such a message might indicate an + attempt to perform request smuggling ... and ought to be handled as an + error", and section 6.1: "A server MAY reject a request that contains + both Content-Length and Transfer-Encoding". Rejected here. +- "If a Transfer-Encoding header field is present and the chunked + transfer coding (Section 7.1) is the final encoding, the message body + length is determined by reading and decoding the chunked data". This + library decodes no other coding, and section 6.1 says "A server that + receives a request message with a transfer coding it does not + understand SHOULD respond with 501 (Not Implemented)". So + Transfer-Encoding is accepted only when its combined field value is a + list of the one coding `chunked`, in any case (RFC 9112, section 7: + "All transfer-coding names are case-insensitive"). Transfer-Encoding + is `#transfer-coding` (section 6.1), and empty list elements do not + count (RFC 9110, section 5.6.1.2), so `chunked,` and `, chunked` are + such lists, and so is a `chunked` field line with an empty one. Any + other value is rejected: + - with no coding, or chunked not last, section 6.3 says "the server + MUST respond with the 400 (Bad Request) status code"; + - with chunked twice, the sender broke section 6.1, "A sender MUST NOT + apply the chunked transfer coding more than once", and RFC 9110, + section 15.5.1, lets a server answer "invalid request message + framing" with 400; + - otherwise, the value names a coding this library does not + understand. +- Section 6.1: "A server or client that receives an HTTP/1.0 message + containing a Transfer-Encoding header field MUST treat the message as + if the framing is faulty". Rejected here. +- "If a message is received without Transfer-Encoding and with an + invalid Content-Length header field, then the message framing is + invalid and the recipient MUST treat it as an unrecoverable error, + unless the field value can be successfully parsed as a comma-separated + list ... and all values in the list are the same". This library does + not take that exception: Content-Length must be one field line whose + value is `1*DIGIT` (RFC 9110, section 8.6). +- "If a valid Content-Length header field is present without + Transfer-Encoding, its decimal value defines the expected message body + length in octets." +- "If this is a request message and none of the above are true, then + the message body length is zero". +-/ + +/-- ASCII lower case. -/ +def Spec.lower (c : UInt8) : UInt8 := if 0x41 ≤ c ∧ c ≤ 0x5A then c + 0x20 else c + +/-- The fields of the head named `n`, given in lower case, compared + without regard to ASCII case. -/ +def Spec.named (h : Head) (n : String) : List Field := + h.fields.filter fun f => f.name.map Spec.lower = Spec.ascii n + +/-- The number that a string of decimal digits writes. -/ +def Spec.decimal (ds : List UInt8) : Nat := ds.foldl (fun n d => 10 * n + (d.toNat - 0x30)) 0 + +/-- The Host rule of section 3.2, with the host that section 3.3 puts in + the target URI not empty: at most one Host field line, exactly one + from HTTP/1.1 on, and its value empty or a host that is not empty + with an optional port. -/ +def Spec.HostOK (h : Head) : Prop := + (Spec.named h "host").length ≤ 1 ∧ (1 ≤ h.minor → (Spec.named h "host").length = 1) ∧ + ∀ f ∈ Spec.named h "host", Spec.Matches Spec.hostField f.value + +/-- The rule of RFC 9110 section 9.3.6 for CONNECT: the target is + `uri-host ":" port`, with a host that is not empty, as for the target + URI of RFC 9112 section 3.3, and a port from 1 to 65535. An empty + port writes 0, so it is refused. -/ +def Spec.ConnectOK (h : Head) : Prop := + h.method = Spec.ascii "CONNECT" → + ∃ host port, h.target = host ++ [0x3A] ++ port ∧ Spec.Matches Spec.hostNonEmpty host ∧ + Spec.Matches Spec.port port ∧ 1 ≤ Spec.decimal port ∧ Spec.decimal port ≤ 65535 + +/-- The rule of RFC 9110 sections 4.2.1, 4.2.2 and 4.2.4 for a target + whose scheme is http or https, for any method but CONNECT. -/ +def Spec.HttpTargetOK (h : Head) : Prop := + h.method ≠ Spec.ascii "CONNECT" → + (Spec.ascii "http:" <+: h.target.map Spec.lower ∨ Spec.ascii "https:" <+: h.target.map Spec.lower) → + Spec.Matches Spec.httpTarget h.target + +/-- The target is not an authority-form target with an empty host: it + does not begin with `:` (RFC 9112 section 3.3, RFC 9110 section + 4.2.1). -/ +def Spec.AuthorityHostOK (h : Head) : Prop := h.target.head? ≠ some 0x3A + +/-- A CONNECT has no content (RFC 9110, section 9.3.6): its body, as + `fr` frames it, has length 0. -/ +def Spec.ConnectNoContent (h : Head) (fr : Framing) : Prop := + h.method = Spec.ascii "CONNECT" → fr = .length 0 + +/-- The combined field value of the field lines `fs` (RFC 9110, section + 5.2): their values in order, separated by commas. -/ +def Spec.combined (fs : List Field) : List UInt8 := List.intercalate [0x2C] (fs.map (·.value)) + +/-- The body after the head is framed as `fr`, by section 6.3 with the + choices above. -/ +def Spec.FramedAs (h : Head) : Framing → Prop + | .chunked => + 1 ≤ h.minor ∧ Spec.named h "content-length" = [] ∧ Spec.named h "transfer-encoding" ≠ [] ∧ + Spec.Matches (Spec.listOne (Re.litCI "chunked")) (Spec.combined (Spec.named h "transfer-encoding")) + | .length n => + Spec.named h "transfer-encoding" = [] ∧ + ((Spec.named h "content-length" = [] ∧ n = 0) ∨ + ∃ f, Spec.named h "content-length" = [f] ∧ Spec.Matches Spec.contentLength f.value ∧ + n = Spec.decimal f.value) + +/-- This library accepts the head, and frames its body as `fr`. -/ +def Spec.Accepts (h : Head) (fr : Framing) : Prop := + h.major = 1 ∧ Spec.HostOK h ∧ Spec.ConnectOK h ∧ Spec.HttpTargetOK h ∧ Spec.AuthorityHostOK h ∧ + Spec.ConnectNoContent h fr ∧ Spec.FramedAs h fr diff --git a/Spec/Rules.lean b/Spec/Rules.lean new file mode 100644 index 0000000..3e054fa --- /dev/null +++ b/Spec/Rules.lean @@ -0,0 +1,259 @@ +/- + The ABNF rules this library reads, written in the notation of + `Http/Abnf.lean`, rule for rule and in the RFCs' own order of + alternatives. Part of the approved specification, with `Spec.lean`, + and written from the RFCs, independently of the code in `Http/`. + + The sources: + - RFC 5234, Appendix B.1: the core rules. + - RFC 9110, sections 4.1, 5.1, 5.5, 5.6.1.2, 5.6.2, 5.6.3, 7.2 and + 8.6: tokens, whitespace, field names and values, a list of one + element, `absolute-path`, `Host` and `Content-Length`. + - RFC 3986, Appendix A: the URI rules the request target uses. + - RFC 9112, sections 3 and 3.2: the method and the four forms of + request target. The version, whose digits `Head` keeps as numbers, + is in `Spec/Defs.lean`. + + A quoted string in ABNF is case-insensitive (RFC 5234, section 2.3), + so it is written `litCI`. +-/ + +import Http.Abnf + +open Http Http.Re + +/-! ## RFC 5234, Appendix B.1 -/ + +/-- `ALPHA = %x41-5A / %x61-7A ; A-Z / a-z` -/ +def Spec.ALPHA : Re := alt (range 0x41 0x5A) (range 0x61 0x7A) + +/-- `DIGIT = %x30-39 ; 0-9` -/ +def Spec.DIGIT : Re := range 0x30 0x39 + +/-- `HEXDIG = DIGIT / "A" / "B" / "C" / "D" / "E" / "F"` -/ +def Spec.HEXDIG : Re := + any [Spec.DIGIT, litCI "A", litCI "B", litCI "C", litCI "D", litCI "E", litCI "F"] + +/-- `VCHAR = %x21-7E ; visible (printing) characters` -/ +def Spec.VCHAR : Re := range 0x21 0x7E + +/-- `SP = %x20` -/ +def Spec.SP : Re := byte 0x20 + +/-- `HTAB = %x09 ; horizontal tab` -/ +def Spec.HTAB : Re := byte 0x09 + +/-! ## RFC 9110 -/ + +/-- `tchar = "!" / "#" / "$" / "%" / "&" / "'" / "*" / "+" / "-" / "." / + "^" / "_" / "`" / "|" / "~" / DIGIT / ALPHA` (section 5.6.2) -/ +def Spec.tchar : Re := + any [litCI "!", litCI "#", litCI "$", litCI "%", litCI "&", litCI "'", litCI "*", litCI "+", + litCI "-", litCI ".", litCI "^", litCI "_", litCI "`", litCI "|", litCI "~", Spec.DIGIT, + Spec.ALPHA] + +/-- `token = 1*tchar` (section 5.6.2) -/ +def Spec.token : Re := plus Spec.tchar + +/-- `OWS = *( SP / HTAB )` (section 5.6.3) -/ +def Spec.OWS : Re := star (alt Spec.SP Spec.HTAB) + +/-- `obs-text = %x80-FF` (section 5.6.4) -/ +def Spec.obsText : Re := range 0x80 0xFF + +/-- `field-vchar = VCHAR / obs-text` (section 5.5) -/ +def Spec.fieldVchar : Re := alt Spec.VCHAR Spec.obsText + +/-- `field-content = field-vchar [ 1*( SP / HTAB / field-vchar ) field-vchar ]` + (section 5.5) -/ +def Spec.fieldContent : Re := + cat Spec.fieldVchar (opt (cat (plus (any [Spec.SP, Spec.HTAB, Spec.fieldVchar])) Spec.fieldVchar)) + +/-- `field-value = *field-content` (section 5.5) -/ +def Spec.fieldValue : Re := star Spec.fieldContent + +/-- `field-name = token` (section 5.1) -/ +def Spec.fieldName : Re := Spec.token + +/-- `Content-Length = 1*DIGIT` (section 8.6) -/ +def Spec.contentLength : Re := plus Spec.DIGIT + +/-- A list with one element, `e`, as a recipient reads a list (section + 5.6.1.2): "a recipient MUST accept lists that satisfy the following + syntax: `#element => [ element ] *( OWS "," OWS [ element ] )`", + where "Empty elements do not contribute to the count of elements + present". With one element present and every other one empty, that + is `*( OWS "," OWS ) element *( OWS "," OWS )`. -/ +def Spec.listOne (e : Re) : Re := + seq [star (seq [Spec.OWS, litCI ",", Spec.OWS]), e, star (seq [Spec.OWS, litCI ",", Spec.OWS])] + +/-! ## RFC 3986, Appendix A -/ + +/-- `unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"` -/ +def Spec.unreserved : Re := any [Spec.ALPHA, Spec.DIGIT, litCI "-", litCI ".", litCI "_", litCI "~"] + +/-- `pct-encoded = "%" HEXDIG HEXDIG` -/ +def Spec.pctEncoded : Re := seq [litCI "%", Spec.HEXDIG, Spec.HEXDIG] + +/-- `sub-delims = "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "="` -/ +def Spec.subDelims : Re := + any [litCI "!", litCI "$", litCI "&", litCI "'", litCI "(", litCI ")", litCI "*", litCI "+", + litCI ",", litCI ";", litCI "="] + +/-- `pchar = unreserved / pct-encoded / sub-delims / ":" / "@"` -/ +def Spec.pchar : Re := any [Spec.unreserved, Spec.pctEncoded, Spec.subDelims, litCI ":", litCI "@"] + +/-- `segment = *pchar` -/ +def Spec.segment : Re := star Spec.pchar + +/-- `segment-nz = 1*pchar` -/ +def Spec.segmentNz : Re := plus Spec.pchar + +/-- `query = *( pchar / "/" / "?" )` -/ +def Spec.query : Re := star (any [Spec.pchar, litCI "/", litCI "?"]) + +/-- `scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )` -/ +def Spec.scheme : Re := cat Spec.ALPHA (star (any [Spec.ALPHA, Spec.DIGIT, litCI "+", litCI "-", litCI "."])) + +/-- `userinfo = *( unreserved / pct-encoded / sub-delims / ":" )` -/ +def Spec.userinfo : Re := star (any [Spec.unreserved, Spec.pctEncoded, Spec.subDelims, litCI ":"]) + +/-- `h16 = 1*4HEXDIG` -/ +def Spec.h16 : Re := between 1 4 Spec.HEXDIG + +/-- `dec-octet = DIGIT / %x31-39 DIGIT / "1" 2DIGIT / "2" %x30-34 DIGIT / + "25" %x30-35` -/ +def Spec.decOctet : Re := + any [Spec.DIGIT, cat (range 0x31 0x39) Spec.DIGIT, cat (litCI "1") (rep 2 Spec.DIGIT), + seq [litCI "2", range 0x30 0x34, Spec.DIGIT], cat (litCI "25") (range 0x30 0x35)] + +/-- `IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet` -/ +def Spec.IPv4address : Re := + seq [Spec.decOctet, litCI ".", Spec.decOctet, litCI ".", Spec.decOctet, litCI ".", Spec.decOctet] + +/-- `ls32 = ( h16 ":" h16 ) / IPv4address` -/ +def Spec.ls32 : Re := alt (seq [Spec.h16, litCI ":", Spec.h16]) Spec.IPv4address + +/-- `h16 ":"`, which `IPv6address` repeats. -/ +def Spec.h16c : Re := cat Spec.h16 (litCI ":") + +/-- ``` + IPv6address = 6( h16 ":" ) ls32 + / "::" 5( h16 ":" ) ls32 + / [ h16 ] "::" 4( h16 ":" ) ls32 + / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 + / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 + / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 + / [ *4( h16 ":" ) h16 ] "::" ls32 + / [ *5( h16 ":" ) h16 ] "::" h16 + / [ *6( h16 ":" ) h16 ] "::" + ``` -/ +def Spec.IPv6address : Re := + any [ + cat (rep 6 Spec.h16c) Spec.ls32, + seq [litCI "::", rep 5 Spec.h16c, Spec.ls32], + seq [opt Spec.h16, litCI "::", rep 4 Spec.h16c, Spec.ls32], + seq [opt (cat (upTo 1 Spec.h16c) Spec.h16), litCI "::", rep 3 Spec.h16c, Spec.ls32], + seq [opt (cat (upTo 2 Spec.h16c) Spec.h16), litCI "::", rep 2 Spec.h16c, Spec.ls32], + seq [opt (cat (upTo 3 Spec.h16c) Spec.h16), litCI "::", Spec.h16, litCI ":", Spec.ls32], + seq [opt (cat (upTo 4 Spec.h16c) Spec.h16), litCI "::", Spec.ls32], + seq [opt (cat (upTo 5 Spec.h16c) Spec.h16), litCI "::", Spec.h16], + cat (opt (cat (upTo 6 Spec.h16c) Spec.h16)) (litCI "::")] + +/-- `IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )` -/ +def Spec.IPvFuture : Re := + seq [litCI "v", plus Spec.HEXDIG, litCI ".", plus (any [Spec.unreserved, Spec.subDelims, litCI ":"])] + +/-- `IP-literal = "[" ( IPv6address / IPvFuture ) "]"` -/ +def Spec.IPliteral : Re := seq [litCI "[", alt Spec.IPv6address Spec.IPvFuture, litCI "]"] + +/-- `reg-name = *( unreserved / pct-encoded / sub-delims )` -/ +def Spec.regName : Re := star (any [Spec.unreserved, Spec.pctEncoded, Spec.subDelims]) + +/-- `host = IP-literal / IPv4address / reg-name` -/ +def Spec.host : Re := any [Spec.IPliteral, Spec.IPv4address, Spec.regName] + +/-- `port = *DIGIT` -/ +def Spec.port : Re := star Spec.DIGIT + +/-- `authority = [ userinfo "@" ] host [ ":" port ]` -/ +def Spec.authority : Re := + seq [opt (cat Spec.userinfo (litCI "@")), Spec.host, opt (cat (litCI ":") Spec.port)] + +/-- `path-abempty = *( "/" segment )` -/ +def Spec.pathAbempty : Re := star (cat (litCI "/") Spec.segment) + +/-- `path-absolute = "/" [ segment-nz *( "/" segment ) ]` -/ +def Spec.pathAbsolute : Re := cat (litCI "/") (opt (cat Spec.segmentNz Spec.pathAbempty)) + +/-- `path-rootless = segment-nz *( "/" segment )` -/ +def Spec.pathRootless : Re := cat Spec.segmentNz Spec.pathAbempty + +/-- `path-empty = 0` -/ +def Spec.pathEmpty : Re := eps + +/-- `hier-part = "//" authority path-abempty / path-absolute / path-rootless / + path-empty` -/ +def Spec.hierPart : Re := + any [seq [litCI "//", Spec.authority, Spec.pathAbempty], Spec.pathAbsolute, Spec.pathRootless, + Spec.pathEmpty] + +/-- `absolute-URI = scheme ":" hier-part [ "?" query ]` -/ +def Spec.absoluteURI : Re := seq [Spec.scheme, litCI ":", Spec.hierPart, opt (cat (litCI "?") Spec.query)] + +/-! ## RFC 9110, sections 4.1, 4.2 and 7.2 -/ + +/-- `absolute-path = 1*( "/" segment )` (section 4.1) -/ +def Spec.absolutePath : Re := plus (cat (litCI "/") Spec.segment) + +/-- `uri-host = ` -/ +def Spec.uriHost : Re := Spec.host + +/-- `Host = uri-host [ ":" port ]` (section 7.2) -/ +def Spec.hostValue : Re := cat Spec.uriHost (opt (cat (litCI ":") Spec.port)) + +/-- A `host` that is not empty: + `IP-literal / IPv4address / 1*( unreserved / pct-encoded / sub-delims )`. + Of the three alternatives of `host`, only `reg-name` can be empty, so + this is `host` with `*` in `reg-name` made `1*`. -/ +def Spec.hostNonEmpty : Re := + any [Spec.IPliteral, Spec.IPv4address, plus (any [Spec.unreserved, Spec.pctEncoded, Spec.subDelims])] + +/-- A Host value this library accepts: empty, or a host that is not empty + with an optional port, `[ hostNonEmpty [ ":" port ] ]`. These are the + values of `Host` (`Spec.hostValue`) but those with an empty host and + a colon, such as `:80` and `:`. The rules for this are in + `Spec/Defs.lean`. -/ +def Spec.hostField : Re := opt (cat Spec.hostNonEmpty (opt (cat (litCI ":") Spec.port))) + +/-- `http-URI = "http" "://" authority path-abempty [ "?" query ]` + (section 4.2.1) and + `https-URI = "https" "://" authority path-abempty [ "?" query ]` + (section 4.2.2), where the authority's host is not empty and the + authority has no `userinfo`, so it is `host [ ":" port ]`. The + rules for this are in `Spec/Defs.lean`. -/ +def Spec.httpTarget : Re := + seq [alt (litCI "http") (litCI "https"), litCI "://", Spec.hostNonEmpty, + opt (cat (litCI ":") Spec.port), Spec.pathAbempty, opt (cat (litCI "?") Spec.query)] + +/-! ## RFC 9112 -/ + +/-- `method = token` (section 3.1) -/ +def Spec.method : Re := Spec.token + +/-- `origin-form = absolute-path [ "?" query ]` (section 3.2.1) -/ +def Spec.originForm : Re := cat Spec.absolutePath (opt (cat (litCI "?") Spec.query)) + +/-- `absolute-form = absolute-URI` (section 3.2.2) -/ +def Spec.absoluteForm : Re := Spec.absoluteURI + +/-- `authority-form = uri-host ":" port` (section 3.2.3) -/ +def Spec.authorityForm : Re := seq [Spec.uriHost, litCI ":", Spec.port] + +/-- `asterisk-form = "*"` (section 3.2.4) -/ +def Spec.asteriskForm : Re := litCI "*" + +/-- `request-target = origin-form / absolute-form / authority-form / + asterisk-form` (section 3.2) -/ +def Spec.requestTarget : Re := + any [Spec.originForm, Spec.absoluteForm, Spec.authorityForm, Spec.asteriskForm] diff --git a/bar.toml b/bar.toml new file mode 100644 index 0000000..4d4f16c --- /dev/null +++ b/bar.toml @@ -0,0 +1,37 @@ +# Read by bar/check.py in Proven-Commons/mission. +# See playbook/verified-bar.md there for what each field means. + +[project] +name = "http" +# "in-progress" until every bar item passes, then "verified". +status = "in-progress" +page = "README.md" +# GitHub handles of everyone who wrote the specification. It was drafted +# by Claude, an AI agent, for the org; its pull requests came from the +# ahrazzle account (plan #1), and orda-aska carried the review fixes. +spec_authors = ["claude", "ahrazzle", "orda-aska"] +# The program people run. A change to it voids the approval. +entry_points = ["Main.lean"] + +[spec] +# Http/Types.lean and Http/Abnf.lean hold the types the statements are +# about, and the notation the grammar is written in, so they are part of +# the specification. +files = [ + "SPEC.md", "Spec.lean", "Spec/Abnf.lean", "Spec/Rules.lean", "Spec/Defs.lean", + "Http/Types.lean", "Http/Abnf.lean", +] +# The code under proof: the functions the statements are about. +code = ["Http.Re.isMatch", "Http.parseHead", "Http.Head.print", "Http.Head.framing"] + +# 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/http/pull/" + +[tests] +results = "tests/TEST-RESULTS.md" +command = "python3 tests/run_tests.py" +files = ["tests/run_tests.py", "tests/planted_bugs.py"] diff --git a/comparator.json b/comparator.json new file mode 100644 index 0000000..9cef432 --- /dev/null +++ b/comparator.json @@ -0,0 +1,19 @@ +{ + "challenge_module": "Spec", + "solution_module": "Proofs", + "theorem_names": [ + "Spec.isMatch_iff", + "Spec.parseHead_iff", + "Spec.print_eq", + "Spec.parseHead_print", + "Spec.framing_iff", + "Spec.framing_te_cl", + "Spec.framing_two_cl", + "Spec.head_vectors" + ], + "permitted_axioms": [ + "propext", + "Quot.sound", + "Classical.choice" + ] +} diff --git a/lake-manifest.json b/lake-manifest.json new file mode 100644 index 0000000..e5fecfa --- /dev/null +++ b/lake-manifest.json @@ -0,0 +1,6 @@ +{"version": "1.3.0", + "packagesDir": ".lake/packages", + "packages": [], + "name": "http", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000..3877aa3 --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,17 @@ +name = "http" +version = "0.1.0" +license = "Apache-2.0" +defaultTargets = ["Http", "Spec", "Proofs", "httphead"] + +[[lean_lib]] +name = "Http" + +[[lean_lib]] +name = "Spec" + +[[lean_lib]] +name = "Proofs" + +[[lean_exe]] +name = "httphead" +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/CROSS-CHECK.md b/tests/CROSS-CHECK.md new file mode 100644 index 0000000..d84dfb3 --- /dev/null +++ b/tests/CROSS-CHECK.md @@ -0,0 +1,215 @@ +# Cross-check with other HTTP parsers + +Written by `tests/cross_check.py`, a one-off comparison that is not part of the verified bar. Its docstring says how the heads are sent and judged, and how a difference gets its category. RFC 9112 lets a recipient repair some malformed heads instead of rejecting them, so a difference here is a different choice, not always an error. + +- Heads: the first 5991 inputs of the differential tests (seed 20261025, `--count 6000`, less the malformed requests to the tool). Every parser is sent all 5991. A head whose verdicts differ is also sent again with features changed, to find its category. +- This project rejects 4160 of them. It accepts 1094 with no body, 496 with a Content-Length from 1 to 1,000,000, 231 as chunked, and 10 with a Content-Length above 1,000,000. +- Sent after the head: nothing after a head this project rejects; the whole body for a Content-Length up to 1,000,000; `5\r\nhello\r\n0\r\n\r\n` (5 octets of data) for chunked; nothing for a Content-Length above 1,000,000, so those heads are judged on the head alone. +- A parser accepts a head when it reads it and passes the request on, even when it then waits for a body that is never sent. +- In the tables, "accepts" means the other parser accepts a head this project rejects, and "rejects" means it rejects a head this project accepts. The examples show the head as sent, cut at 100 octets. +- Categories: for a head the other parser accepts, the first reason this project rejects it. For a head the other parser rejects, the first feature whose change alone makes that parser accept it, or, after "together:", the features whose changes it needs at once. The script checks that it finds a reason to reject in each head this project rejects and in no other, and that each change keeps a head this project accepts. + +## Node v22.22.0 (llhttp) + +- Heads sent: 5991 +- Same verdict: 4377 (859 both accept, 3518 both reject) +- Different verdict: 1608 (636 it accepts and this project rejects, 972 it rejects and this project accepts) +- No answer: 6 +- Body lengths compared, where both accept: 803. Of those, 579 have no body and 224 a non-zero length (183 by Content-Length, 41 chunked). 803 read the same length and 0 another. +- Not compared, where both accept: 0 with a Content-Length above 1,000,000, and 56 whose answer has no count. + +The heads it rejects and this project accepts, by the feature whose change makes it accept them: alone, or together with other changes. + +| Feature | Alone | With others | +| --- | --- | --- | +| a method other than the registered ones | 201 | 167 | +| the authority-form with a method other than CONNECT | 118 | 95 | +| a tab after a Content-Length or Transfer-Encoding value | 100 | 91 | +| an absolute-form target with no authority | 111 | 71 | +| HTTP/1.2 to 1.9 | 90 | 90 | +| a Transfer-Encoding list with empty elements | 53 | 67 | +| a scheme with a digit, "+", "-" or "." | 16 | 10 | +| a Content-Length of 2^63 or more | 6 | 4 | + +Where it differs from this project (the two shortest examples): + +| It | Category | Heads | Examples | +| --- | --- | --- | --- | +| rejects | a method other than the registered ones | 201 | `b'Connect / HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'IyUqp * HTTP/1.1\r\nhOsT: [::]:80 \r\n\r\n'` | +| accepts | a major version other than 1 | 123 | `b'GET / HTTP/2.0\r\nHost: a\r\n\r\n'`, `b'DELETE * HTTP/2.0\r\nhost::80 \r\n\r\n'` | +| accepts | a Host value with a bad IP literal | 121 | `b'GET / HTTP/1.1\r\nHost: ::1\r\n\r\n'`, `b'GET / HTTP/1.1\r\nHost: [v.a]\r\n\r\n'` | +| rejects | the authority-form with a method other than CONNECT | 118 | `b'POST 200.9.99.250:443 HTTP/1.1\r\nHOST: \t\r\n\r\n'`, `b'OPTIONS [::]:0 HTTP/1.1\r\neqg: \r\nhOsT: ~x \r\n\r\n'` | +| rejects | an absolute-form target with no authority | 111 | `b'GET htt:a HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'GET http.s:/ HTTP/1.1\r\nHost: a\r\n\r\n'` | +| rejects | a tab after a Content-Length or Transfer-Encoding value | 100 | `b'POST /s?+JLC HTTP/1.0\r\ncontent-length: \t 425853\t\r\nHOST:\tJ$ \t \r\n\r\n'`, `b'PATCH /Qm/;/q/is%EA HTTP/1.1\r\nhOsT: h \t \r\nCONTENT-LENGTH: 702742 \t \r\n\r\n'` | +| rejects | HTTP/1.2 to 1.9 | 90 | `b'GET / HTTP/1.2\r\nHost: a\r\n\r\n'`, `b'HEAD /RUXBl HTTP/1.2\r\nhost: [::]:80 \r\n\r\n'` | +| accepts | two Host lines | 66 | `b'GET / HTTP/1.0\r\nHost: a\r\nHost: b\r\n\r\n'`, `b'GET / HTTP/1.1\r\nHost: a\r\nHost: a\r\n\r\n'` | +| rejects | a Transfer-Encoding list with empty elements | 53 | `b'POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,\r\n\r\n'`, `b'POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: ,chunked,\r\n\r\n'` | +| accepts | a Host value with an empty host, such as `:80` | 47 | `b'GET / HTTP/1.1\r\nHost: :\r\n\r\n'`, `b'GET / HTTP/1.1\r\nHost: :80\r\n\r\n'` | +| rejects | together: the authority-form with a method other than CONNECT; a method other than the registered ones | 34 | `b'connect :80 HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'MRoJ%2 P%Cf:443 HTTP/1.1\r\nhOsT:\tx.fZwWC \r\n\r\n'` | +| rejects | together: a method other than the registered ones; an absolute-form target with no authority | 33 | `b'connect a: HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'\r\n\r\n6 http.s:PhwcQ HTTP/1.0\r\nHost: [::]:65535 \r\n\r\n'` | +| accepts | CONNECT whose target is not a host and port | 32 | `b'CONNECT * HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'CONNECT / HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | another Host value outside RFC 3986 | 32 | `b'GET / HTTP/1.1\r\nHost: a b\r\n\r\n'`, `b'DELETE /)Uym HTTP/1.1\r\nhost:\tx? \r\n\r\n'` | +| rejects | together: a method other than the registered ones; a tab after a Content-Length or Transfer-Encoding value | 30 | `b'A * HTTP/1.1\r\nHOST: \t \r\nContent-Length:5 \t \r\n\r\n'`, `b'3 /ZA HTTP/1.1\r\ncontent-length: \t 28723\t\r\nHost:\tKJ2aB%b3H: \t \r\n47:0I)B7 \r\n\r\n'` | +| accepts | CONNECT with a port above 65535 | 28 | `b'CONNECT ZVPta$%bf:99999 HTTP/1.1\r\n\r\n'`, `b'CONNECT a:65536 HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | Transfer-Encoding in HTTP/1.0 | 24 | `b'POST /a HTTP/1.0\r\nTransfer-Encoding: chunked\r\n\r\n'`, `b'OPTIONS /S1/@ HTTP/1.0\r\nm+PTgQe:_ \t\t\xbfwK \r\nHost:[::D5a:ed32] \r\nTRANSFER-ENCODING: gzip, chunked \r\n\r\n'` | +| accepts | an http or https target with no host | 23 | `b'GET http:// HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'GET https:// HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | an http or https target with userinfo | 22 | `b'GET http://@a/ HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'GET http://u@/ HTTP/1.1\r\nHost: a\r\n\r\n'` | +| rejects | together: HTTP/1.2 to 1.9; a method other than the registered ones | 20 | `b'AY0.6C * HTTP/1.9\r\nhOsT: ptF_$dy: \r\n\r\n'`, `b'L#GWP#i9 * HTTP/1.9\r\nhOsT:Xn \r\nEZ9_:,)1"h0H$` \r\n\r\n'` | +| accepts | CONNECT with an empty host | 17 | `b'CONNECT :443 HTTP/1.0\r\n\r\n'`, `b'CONNECT : HTTP/1.1\r\nHost: a\r\n\r\n'` | +| rejects | together: HTTP/1.2 to 1.9; a Transfer-Encoding list with empty elements | 17 | `b"OPTIONS /U?XPY HTTP/1.9\r\nko3R69KF: \x88Y'f\t@$\r\nHost:\t[D02d:C4:F:A:fe58:a7:8:e30]\t\r\nTransfer-Encoding:,"`, `b"GET /'~XD/:P?9nh1s/+o HTTP/1.9\r\nTRANSFER-ENCODING: Chunked \r\nTransfer-Encoding: ,\t\r\nHOST: 199.9.249"` | +| rejects | together: a method other than the registered ones; a Transfer-Encoding list with empty elements | 17 | `b'OZxN!T. * HTTP/1.1\r\nHOST:10.255.255.1\r\n7S: h zQo:!Je \r\nTransfer-Encoding: \t CHUNKED ,\r\n*2u3: \tZw \t \r'`, `b'\r\n\r\nj /=nLs@/%47?Fu HTTP/1.1\r\nHost:[vFA.v&nb]\r\ntransfer-encoding:\t , ,\t \t , ChUNKed , \t , \r\nsW:'` | +| accepts | other whitespace in the request line | 16 | `b'GET /a HTTP/1.1\r\nHost: x\r\n\r\n'`, `b'PATCH * HTTP/1.1\r\nHost: \r\no8s: \xa9\r\n\r\n'` | +| rejects | a scheme with a digit, "+", "-" or "." | 16 | `b'TRACE a+b.c-d://JpR-c%d6:95702 HTTP/1.1\r\nhOsT:A!0(r2.n) \r\n\r\n'`, `b'\r\n\r\nPOST https+x://%3Fbx@/tdT@=v/R9g%89t)?pQXsKH;M HTTP/1.1\r\nhOsT:\t!GJT.U.*.V\t\r\n\r\n'` | +| accepts | a target with a bad IP literal | 15 | `b'GET http://[v1.]/ HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'GET http://[1::2::3]/ HTTP/1.1\r\nHost: x\r\n\r\n'` | +| rejects | together: the authority-form with a method other than CONNECT; a tab after a Content-Length or Transfer-Encoding value | 15 | `b'POST 199.9.1.200:65535 HTTP/1.1\r\nE5hxH:\tr\x96V\t5[CxF\tk\t\xf0\xac \r\nHOST: \r\ncontent-length:295962\t\r\n\r\n'`, `b'PATCH [::B:DD08:6C:891c:A5]:80 HTTP/1.1\r\nhOsT:KXO-.fIfPiLj*.zPBbU \r\nContent-Length:\t509191\t\r\n\r\n'` | +| rejects | together: an absolute-form target with no authority; a tab after a Content-Length or Transfer-Encoding value | 14 | `b'OPTIONS a+b.c-d:/VF(.YY HTTP/1.1\r\ncontent-length:391873\t\r\nhOsT: SxN%15.S)Dj:443\r\n\r\n'`, `b'HEAD ws:/oGL. HTTP/1.1\r\ng+: /*\t8F9m}<$:N\xd4 %t\t\r\nHost:\t+LO:65535 \r\ncontent-length: 0 \t \r\n\r\n'` | +| rejects | together: the authority-form with a method other than CONNECT; a Transfer-Encoding list with empty elements | 14 | `b'POST DW~g:443 HTTP/1.1\r\nTRANSFER-ENCODING:\tchunked,\t\r\nhOsT:\t[7::A3A5:0:Ae5]\t\r\n\r\n'`, `b'GET :8080 HTTP/1.1\r\nHOST: i \r\nZ: ;y1w@ \r\nkqtFN3H: ZR\r\nH-+: \t 3jt yY \r\nTransfer-Encoding: chunke'` | +| rejects | together: HTTP/1.2 to 1.9; a tab after a Content-Length or Transfer-Encoding value | 11 | `b"HEAD /p//%3aU3e$*/'Jc HTTP/1.2\r\nhOsT: \t ;z:443 \r\nContent-Length:610243\t\r\n\r\n"`, `b'HEAD HTTPX://+_/oAp HTTP/1.2\r\n\|bTv:\xc4 \r\nContent-Length: \t 913464\t\r\nG&^X7YR: P\xdav62Mr \t \r\nhOsT:\t9.100.'` | +| accepts | a bare LF | 10 | `b'\n\r\nGET / HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'\n\r\nDELETE /R@M HTTP/1.1\r\nhOsT:\t:80 \t \r\n\r\n'` | +| rejects | together: HTTP/1.2 to 1.9; an absolute-form target with no authority | 10 | `b'\r\n\r\nDELETE HTTPX:*%3d=67 HTTP/1.9\r\nHost: \t [0d:BBf5::Da:a7:b3F7]\t\r\n\r\n'`, `b'PATCH https+x: HTTP/1.9\r\nQq2mBD*2:\t \t \r\njuf.: $mu!\xb7Xn \xc5A\xfb7d \r\nO: \t ^\t\r\nHost: qVt-l:443\t\r\n\r\n'` | +| accepts | CONNECT with an empty port | 9 | `b'CONNECT a: HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'CONNECT http: HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | a target with a bad percent escape | 9 | `b'GET /%4g HTTP/1.1\r\nHost: x\r\n\r\n'`, `b'GET /%zz HTTP/1.1\r\nHost: x\r\n\r\n'` | +| rejects | together: HTTP/1.2 to 1.9; the authority-form with a method other than CONNECT | 9 | `b"POST [9:ABA:DB::C79:Aa55:f3Ea:2]:8080 HTTP/1.2\r\nHost: %91.qw'zr~:443 \t \r\n\r\n"`, `b'GET 0.250.99.213:0 HTTP/1.2\r\nHOST: 6oeD.2UR%7DbLh7 \r\nContent-Length: 5 \r\n\r\n'` | +| accepts | another target outside RFC 3986 | 6 | `b'GET /a#frag HTTP/1.1\r\nHost: x\r\n\r\n'`, `b'CONNECT ::1:80 HTTP/1.1\r\nHost: a\r\n\r\n'` | +| rejects | a Content-Length of 2^63 or more | 6 | `b'DELETE /W,/D8gX@/?B/ HTTP/1.0\r\nhOsT:L.XM\r\nCONTENT-LENGTH: 18446744073709551616 \r\n\r\n'`, `b'PATCH /Vn/Al@/*:%DF:/XPb HTTP/1.1\r\n-: caD~$\t\xf1{fm\xbf\r\ncontent-length:18446744073709551616 \t \r\nhost: 2'` | +| rejects | together: HTTP/1.2 to 1.9; the authority-form with a method other than CONNECT; a method other than the registered ones | 6 | `b'XY6N u%F22eY.kK%dDlc%47:65535 HTTP/1.9\r\nO~7ue: \t\r\n8`t\|m.*: \\\t7\tG3/\xeaI \tO?\xc8[) \r\nHost:\t[V8.z0] \t \r\n\r\n'`, `b'5a3x-oKN [VE.A]:8080 HTTP/1.2\r\ntransfer-encoding: , chunked \r\n+b: N \x990~ \xb1\xe2W`7$\r\nhOsT:\t0.9.0.250:80'` | +| rejects | together: the authority-form with a method other than CONNECT; a method other than the registered ones; a Transfer-Encoding list with empty elements | 6 | `b'9H 9.99.0.210:80 HTTP/1.1\r\nTRANSFER-ENCODING: , , ChunKed \t \r\nIb9e: qQrrk\t\r\nHOST: [B::6FDD:e80b] '`, `b"lWl%c ;y.T:65535 HTTP/1.1\r\ntransfer-encoding: \t, \t \r\ntransfer-encoding: chunked\r\nhost: x&.'RGKJ1 \r\nt"` | +| accepts | CONNECT with port 0 | 5 | `b'CONNECT a:0 HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'CONNECT a:00 HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | a Transfer-Encoding with another coding before chunked | 5 | `b'POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: gzip, chunked\r\n\r\n'`, `b'CONNECT 5%3CsOppl.Yetm%eDk.!%84F)3K:30136 HTTP/1.1\r\nHOST: rNRE:0\r\nTRANSFER-ENCODING:x\t,\tchunked\t\r\n\r'` | +| accepts | a bare CR | 5 | `b'\r\r\nHEAD / HTTP/1.1\r\nContent-Length: \t 996606 \r\nhOsT: \t :80 \r\n\r\n'`, `b"\rCONNECT /i%f7%7cGy%78/j*QCyl//1S; HTTP/1.1\r\n'5:]!JyYDil/& t&G =\r\nHost: 2l3'` | +| rejects | together: the authority-form with a method other than CONNECT; a method other than the registered ones; a tab after a Content-Length or Transfer-Encoding value | 5 | `b'aL 199.10.1.199:80 HTTP/1.1\r\nHost:200.0.250.196 \r\nCONTENT-LENGTH:\t736918\t\r\n\r\n'`, `b'#h&F [cc44:F:69:60A:4B0:4EeD:B0:C69]: HTTP/1.1\r\ncontent-length: \t 007\t\r\nhost: \t 9j%6B.PuVg%0cbmT\t\r\n\r'` | +| accepts | a Transfer-Encoding with another coding before chunked, over two or more lines | 3 | `b'POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: gzip\r\nTransfer-Encoding: chunked\r\n\r\n'`, `b'\r\nPUT //y,$?l/z3? HTTP/1.1\r\nhost: 0.1.250.249 \r\ntransfer-encoding:\tchunk \r\nTransfer-Encoding:\tchunke'` | +| accepts | a Transfer-Encoding with no coding | 3 | `b'POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\r\n\r\n'`, `b'HEAD //6Oe-)e HTTP/1.1\r\nTRANSFER-ENCODING:\t \r\nhOsT: 199.249.9.199 \t \r\n\r\n'` | +| accepts | a request line that is not three parts | 3 | `b'GET /lH@EYF?)$ExHTTP/1.0\r\nHost: ZVR58k%F7.)0i_Hc.G!$!Aqm\t\r\n\r\n'`, `b'HEAD Http://200.250.99.99//n/)wXA.T/9lk!HTTP/1.1\r\nY6h: \t \r\nUH9!Qj:*GG$O\t*;&_\t\t-5 \r\n\r\n'` | +| accepts | no Host, in HTTP/1.1 to 1.9 | 3 | `b"CONNECT mNY.x7%e7hXt+.Y:000000000063466 HTTP/1.1\r\nH0W'`: S\t/p\r\nE0kO: Wi@ZN:u\xfe \r\n\r\n"`, `b'CONNECT ~7g;3%8Eqs.8T0i.-zWt%FA:1 HTTP/1.1\r\n4.W.:\tvO; \r\nn~k90: \t \t> #\|u\xf8 \r\nOsT:jZBoysD.s%5B_QmW3.Tb'` | +| no answer | empty lines before the request line | 3 | `b'\r\n'` | +| accepts | a Transfer-Encoding with no coding, over two or more lines | 2 | `b'GET /7lGbG//%1CN0?H/@ HTTP/1.1\r\nN6A31vq:\t\t\xe68z\xbb]Q(L\t<,\xd0\r\nPr: 8yw\x82w\xeeX0;;q%22\| \xb9f \t \r\nTransfer-Encoding'`, `b"CONNECT 'V.kAIkT.l:000000019020 HTTP/1.1\r\nhost:\t:: \r\nuCl'mwR: B8/5\xc7 \r\nTRANSFER-ENCODING:\t, \r\nG~4c:"` | +| no answer | a bare CR | 2 | `b'\r'`, `b'\r\n\r'` | +| rejects | together: HTTP/1.2 to 1.9; a method other than the registered ones; a Transfer-Encoding list with empty elements | 2 | `b's0i //:SqNz HTTP/1.9\r\nD*: \t ,PB\t\trE\x80mp!\xe8p7u \r\ntransfer-encoding: CHUNKED , \r\neal9S*6: \xecL1{VL8< \t \r'`, `b'\r\n\r\n1It.!%.N ///V1c HTTP/1.9\r\nTransfer-Encoding: \r\nHOST: yKZcsc.y_o*vp.4N2E%4a%25 \r\nTRANSFER-ENCODIN'` | +| rejects | together: HTTP/1.2 to 1.9; a method other than the registered ones; a tab after a Content-Length or Transfer-Encoding value | 2 | `b'\r\n&%$ //!H/p_ HTTP/1.2\r\nCONTENT-LENGTH: 450377 \t \r\nhost: 99.175.99.250\r\n\r\n'`, `b"\r\nGe+3w1$R /%44tH/%9e$sy3- HTTP/1.9\r\nHOST: [bE6:53::fa]:65535 \r\nCONTENT-LENGTH: 778517 \t \r\nAi': \t \r"` | +| rejects | together: HTTP/1.2 to 1.9; a scheme with a digit, "+", "-" or "."; a Transfer-Encoding list with empty elements | 2 | `b"GET a+b.c-d://o'ZHM%4Dz.,_u HTTP/1.9\r\nm8H: P# \r\nTRANSFER-ENCODING: \t ,\t \t , \t ,CHunked \t ,\t, , \r\nHO"`, `b'OPTIONS a+b.c-d://[BB:fB:b9B:45DE:fB1b:BB:61e3:af]:443/)RS/xTf5q/f HTTP/1.9\r\nWfCF.t: g[\xa6h\xf5S3%2q$0y\r\n'` | +| rejects | together: HTTP/1.2 to 1.9; an absolute-form target with no authority; a tab after a Content-Length or Transfer-Encoding value | 2 | `b'PUT HTTPX: HTTP/1.9\r\nContent-Length: 700875\t\r\n63TQiv`I: \xa2@ \r\nhGG7b: \t fF$44\teni\t \r\nhOsT: LAN.&wL5s '`, `b"HEAD http.s:?%BDns.,%Fc HTTP/1.2\r\nY'V!!w^:\t+\xdbNH$q \r\no: \x8eg"l^\x14v\xc8Y"\tn\r\n\r\n'` | +| accepts | CONNECT with port 0 | 4 | `b'CONNECT a:0 HTTP/1.1\r\nHost: a\r\n\r\n'`, `b'CONNECT a:00 HTTP/1.1\r\nHost: a\r\n\r\n'` | +| accepts | two Content-Length lines with the same value | 3 | `b'POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 5\r\n\r\n'`, `b'6py#u //%AAW?%d9%Bd HTTP/1.0\r\nHOST: [vfCB7.2yF] \r\nContent-Length: 876352\r\nContent-Length: 876352\r'` | +| no answer | a request line that is not three parts | 1 | `b''` | diff --git a/tests/PLANTED-BUGS.md b/tests/PLANTED-BUGS.md new file mode 100644 index 0000000..36c0d64 --- /dev/null +++ b/tests/PLANTED-BUGS.md @@ -0,0 +1,475 @@ +# Planted bugs + +Written by `python3 tests/planted_bugs.py`. Each row is one small change to the +code, made in a copy. The tests ran on 300,000 inputs from their recorded seed +against the changed tool. A bug is caught when they report failures. + +| Bug | File | Failures | +|-----|------|----------| +| bare LF ends a line | `Http/Head.lean` | 6090 | +| bare CR kept in a line | `Http/Head.lean` | 0, equivalent: the code gives `none` for a CR that is not followed by LF, and the change keeps that CR in the line instead. Every line is then read by parseHead or parseField, and neither accepts a CR: not in the method (a token), the target (no rule of the target grammar has 0x0D), the version (exactly `HTTP/` digit `.` digit), a field name (a token) or a field value (trim removes only SP and HTAB, and isFieldValue allows only field-vchar, SP and HTAB). A line holding a CR is not empty, so it never ends the head. So parseHead gives `none` in both, and on every other input the code is the same | +| space before colon dropped | `Http/Head.lean` | 8646 | +| trailing whitespace kept | `Http/Head.lean` | 206968 | +| NUL allowed in a value | `Http/Head.lean` | 3433 | +| a double quote in a token | `Http/Head.lean` | 17 | +| empty lines first not skipped | `Http/Head.lean` | 38254 | +| minor version digit unchecked | `Http/Head.lean` | 67 | +| Host not required in HTTP/1.1 | `Http/Framing.lean` | 5825 | +| two Host lines accepted | `Http/Framing.lean` | 929 | +| upper-case field names matched twice | `Http/Framing.lean` | 0, equivalent: on every head that parseHead gives, the only heads the tool frames, it matches the same fields. `n.map (c - 0x20)` is `HOST` for `host`, which the first test already matches. For `content-length` and `transfer-encoding` it turns `-` (0x2D) into CR (0x0D), and a field name is a token, so it never holds a CR. The proof of framing_iff, which covers every Head, would catch it; the tests cannot | +| any major version accepted | `Http/Framing.lean` | 17711 | +| first of several Content-Length taken | `Http/Framing.lean` | 4234 | +| Content-Length and port digits read backwards | `Http/Framing.lean` | 23606 | +| Transfer-Encoding overrides Content-Length | `Http/Framing.lean` | 1889 | +| Transfer-Encoding in HTTP/1.0 accepted | `Http/Framing.lean` | 2891 | +| chunked compared case-sensitively | `Http/Grammar.lean` | 7112 | +| list: no empty elements before chunked | `Http/Grammar.lean` | 4546 | +| list: no empty elements after chunked | `Http/Grammar.lean` | 5047 | +| list: at most one empty element before chunked | `Http/Grammar.lean` | 2785 | +| list: a tab is not OWS | `Http/Grammar.lean` | 2335 | +| Transfer-Encoding only as one field line | `Http/Framing.lean` | 3057 | +| only the first Transfer-Encoding line read | `Http/Framing.lean` | 3880 | +| Transfer-Encoding lines joined with no comma | `Http/Framing.lean` | 351 | +| CONNECT rule removed | `Http/Framing.lean` | 1786 | +| CONNECT port up to 65536 | `Http/Framing.lean` | 84 | +| CONNECT port 0 and empty port accepted | `Http/Framing.lean` | 393 | +| CONNECT port 0 accepted | `Http/Framing.lean` | 209 | +| CONNECT port limited to five digits | `Http/Framing.lean` | 306 | +| CONNECT port leading zeros counted as digits | `Http/Framing.lean` | 485 | +| CONNECT method compared case-insensitively | `Http/Framing.lean` | 549 | +| CONNECT target form unchecked | `Http/Framing.lean` | 128 | +| CONNECT target may have an empty host | `Http/Grammar.lean` | 0, equivalent: `hostNonEmpty` and `uriHost` differ only on the empty host, so the change lets through only a CONNECT target that begins with `:`. `Head.framing` refuses every target that begins with `:` (an authority-form target with an empty host, RFC 9112 section 3.3), for any method, so the answer is the same on every input | +| empty host allowed in an authority-form target | `Http/Framing.lean` | 542 | +| CONNECT content accepted | `Http/Framing.lean` | 1222 | +| CONNECT with Content-Length accepted | `Http/Framing.lean` | 828 | +| CONNECT content rule in any case of the method | `Http/Framing.lean` | 429 | +| empty host allowed in a Host value | `Http/Grammar.lean` | 4026 | +| CONNECT port read from every digit | `Http/Framing.lean` | 1234 | +| http target rule removed | `Http/Framing.lean` | 3624 | +| userinfo allowed in an http target | `Http/Grammar.lean` | 942 | +| empty host allowed in an http target (reg-name star) | `Http/Grammar.lean` | 5227 | +| scheme compared case-sensitively in the http target grammar | `Http/Grammar.lean` | 3003 | +| scheme compared case-sensitively in the http and https prefix test | `Http/Framing.lean` | 1777 | +| CONNECT not exempt from the http target rule | `Http/Framing.lean` | 245 | +| CONNECT exempt from the http target rule in any case | `Http/Framing.lean` | 174 | +| https targets not checked | `Http/Framing.lean` | 1836 | +| a percent escape's second digit unchecked | `Http/Grammar.lean` | 90 | +| 256 as an IPv4 octet | `Http/Grammar.lean` | 159 | +| dec-octet 25 then any digit | `Http/Grammar.lean` | 320 | +| dec-octet 2 then any two digits | `Http/Grammar.lean` | 654 | +| dec-octet with a leading zero | `Http/Grammar.lean` | 357 | +| dec-octet as 1*3DIGIT | `Http/Grammar.lean` | 1667 | +| IP literal with a zone ID | `Http/Grammar.lean` | 2582 | +| host may be a bare IPv6 address | `Http/Grammar.lean` | 1193 | +| IPvFuture v case-sensitive | `Http/Grammar.lean` | 2936 | + +## The changes + +**bare LF ends a line** in `Http/Head.lean`: + +``` +- else if c == 0x0A then none +- ++ else if c == 0x0A then some ([], rest) ++ +``` + +**bare CR kept in a line** in `Http/Head.lean`: + +``` +- | d :: rest' => if d == 0x0A then some (acc.reverse, rest') else none ++ | d :: rest' => if d == 0x0A then some (acc.reverse, rest') else takeLineFrom (c :: acc) rest +``` + +**space before colon dropped** in `Http/Head.lean`: + +``` +- let name := line.takeWhile (· != 0x3A) +- ++ let name := (line.takeWhile (· != 0x3A)).filter (· != 0x20) ++ +``` + +**trailing whitespace kept** in `Http/Head.lean`: + +``` +- ((v.dropWhile isWs).reverse.dropWhile isWs).reverse ++ v.dropWhile isWs +``` + +**NUL allowed in a value** in `Http/Head.lean`: + +``` +- def isVchar (c : UInt8) : Bool := (0x21 ≤ c && c ≤ 0x7E) || 0x80 ≤ c ++ def isVchar (c : UInt8) : Bool := (0x21 ≤ c && c ≤ 0x7E) || 0x80 ≤ c || c == 0 +``` + +**a double quote in a token** in `Http/Head.lean`: + +``` +- 0x60, 0x7C, 0x7E].contains c ++ 0x60, 0x7C, 0x7E, 0x22].contains c +``` + +**empty lines first not skipped** in `Http/Head.lean`: + +``` +- | c :: d :: rest => if c == 0x0D && d == 0x0A then skipEmpty rest else c :: d :: rest ++ | c :: d :: rest => c :: d :: rest +``` + +**minor version digit unchecked** in `Http/Head.lean`: + +``` +- isDigit a && isDigit b then ++ isDigit a then +``` + +**Host not required in HTTP/1.1** in `Http/Framing.lean`: + +``` +- || (1 ≤ h.minor && hosts.length != 1) ++ +``` + +**two Host lines accepted** in `Http/Framing.lean`: + +``` +- || hosts.length > 1 ++ +``` + +**upper-case field names matched twice** in `Http/Framing.lean`: + +``` +- def Field.isNamed (f : Field) (n : List UInt8) : Bool := f.name.map lower == n ++ def Field.isNamed (f : Field) (n : List UInt8) : Bool := f.name.map lower == n || f.name == n.map (fun c => c - 0x20) +``` + +**any major version accepted** in `Http/Framing.lean`: + +``` +- if h.major != 1 || ++ if +``` + +**first of several Content-Length taken** in `Http/Framing.lean`: + +``` +- | [], [f] => if ++ | [], f :: _ => if +``` + +**Content-Length and port digits read backwards** in `Http/Framing.lean`: + +``` +- def decimal (ds : List UInt8) : Nat := ds.foldl (fun n d => 10 * n + (d.toNat - 0x30)) 0 ++ def decimal (ds : List UInt8) : Nat := ds.foldr (fun d n => 10 * n + (d.toNat - 0x30)) 0 +``` + +**Transfer-Encoding overrides Content-Length** in `Http/Framing.lean`: + +``` +- | _, _ => none +- ++ | t :: ts, _ => ++ if 1 ≤ h.minor && Grammar.chunkedList.isMatch (List.intercalate [0x2C] ((t :: ts).map (·.value))) ++ then some .chunked else none ++ | _, _ => none ++ +``` + +**Transfer-Encoding in HTTP/1.0 accepted** in `Http/Framing.lean`: + +``` +- if 1 ≤ h.minor && Grammar.chunkedList.isMatch ++ if Grammar.chunkedList.isMatch +``` + +**chunked compared case-sensitively** in `Http/Grammar.lean`: + +``` +- def chunkedList : Re := listOne (litCI "chunked") ++ def chunkedList : Re := listOne (lit "chunked") +``` + +**list: no empty elements before chunked** in `Http/Grammar.lean`: + +``` +- seq [star (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])] ++ seq [e, star (seq [OWS, litCI ",", OWS])] +``` + +**list: no empty elements after chunked** in `Http/Grammar.lean`: + +``` +- seq [star (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])] ++ seq [star (seq [OWS, litCI ",", OWS]), e] +``` + +**list: at most one empty element before chunked** in `Http/Grammar.lean`: + +``` +- seq [star (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])] ++ seq [opt (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])] +``` + +**list: a tab is not OWS** in `Http/Grammar.lean`: + +``` +- def OWS : Re := star (alt SP HTAB) ++ def OWS : Re := star SP +``` + +**Transfer-Encoding only as one field line** in `Http/Framing.lean`: + +``` +- | t :: ts, [] => +- if 1 ≤ h.minor && Grammar.chunkedList.isMatch (List.intercalate [0x2C] ((t :: ts).map (·.value))) +- ++ | [t], [] => ++ if 1 ≤ h.minor && Grammar.chunkedList.isMatch t.value ++ +``` + +**only the first Transfer-Encoding line read** in `Http/Framing.lean`: + +``` +- ((t :: ts).map (·.value)) ++ ([t].map (·.value)) +``` + +**Transfer-Encoding lines joined with no comma** in `Http/Framing.lean`: + +``` +- List.intercalate [0x2C] ++ List.intercalate [] +``` + +**CONNECT rule removed** in `Http/Framing.lean`: + +``` +- !h.connectOK || ++ +``` + +**CONNECT port up to 65536** in `Http/Framing.lean`: + +``` +- decimal ds ≤ 65535 else false ++ decimal ds ≤ 65536 else false +``` + +**CONNECT port 0 and empty port accepted** in `Http/Framing.lean`: + +``` +- then 1 ≤ decimal ds && ++ then 0 ≤ decimal ds && +``` + +**CONNECT port 0 accepted** in `Http/Framing.lean`: + +``` +- portInRange (portOf h.target)) ++ (portInRange (portOf h.target) || (!(portOf h.target).isEmpty && (portOf h.target).all (· == 0x30)))) +``` + +**CONNECT port limited to five digits** in `Http/Framing.lean`: + +``` +- then 1 ≤ decimal ds && decimal ds ≤ 65535 else false ++ then 1 ≤ decimal ds else false +``` + +**CONNECT port leading zeros counted as digits** in `Http/Framing.lean`: + +``` +- let ds := ds.dropWhile (· == 0x30) +- ++ +``` + +**CONNECT method compared case-insensitively** in `Http/Framing.lean`: + +``` +- h.method != connectName || ++ h.method.map lower != connectName.map lower || +``` + +**CONNECT target form unchecked** in `Http/Framing.lean`: + +``` +- (Grammar.connectTarget.isMatch h.target && portInRange ++ (portInRange +``` + +**CONNECT target may have an empty host** in `Http/Grammar.lean`: + +``` +- def connectTarget : Re := seq [hostNonEmpty, litCI ":", port] ++ def connectTarget : Re := seq [uriHost, litCI ":", port] +``` + +**empty host allowed in an authority-form target** in `Http/Framing.lean`: + +``` +- h.target.head? == some 0x3A || ++ +``` + +**CONNECT content accepted** in `Http/Framing.lean`: + +``` +- || (h.method == connectName && fr != .length 0) ++ +``` + +**CONNECT with Content-Length accepted** in `Http/Framing.lean`: + +``` +- (h.method == connectName && fr != .length 0) ++ (h.method == connectName && fr == .chunked) +``` + +**CONNECT content rule in any case of the method** in `Http/Framing.lean`: + +``` +- (h.method == connectName && fr != .length 0) ++ (h.method.map lower == connectName.map lower && fr != .length 0) +``` + +**empty host allowed in a Host value** in `Http/Grammar.lean`: + +``` +- def hostField : Re := opt (cat hostNonEmpty (opt (cat (litCI ":") port))) ++ def hostField : Re := opt (cat host (opt (cat (litCI ":") port))) +``` + +**CONNECT port read from every digit** in `Http/Framing.lean`: + +``` +- def portOf (t : List UInt8) : List UInt8 := (t.reverse.takeWhile isDigit).reverse ++ def portOf (t : List UInt8) : List UInt8 := t.filter isDigit +``` + +**http target rule removed** in `Http/Framing.lean`: + +``` +- || !h.httpTargetOK ++ +``` + +**userinfo allowed in an http target** in `Http/Grammar.lean`: + +``` +- litCI "://", hostNonEmpty, ++ litCI "://", opt (cat userinfo (litCI "@")), hostNonEmpty, +``` + +**empty host allowed in an http target (reg-name star)** in `Http/Grammar.lean`: + +``` +- plus (any [unreserved, pctEncoded, subDelims]) ++ star (any [unreserved, pctEncoded, subDelims]) +``` + +**scheme compared case-sensitively in the http target grammar** in `Http/Grammar.lean`: + +``` +- alt (litCI "http") (litCI "https") ++ alt (lit "http") (lit "https") +``` + +**scheme compared case-sensitively in the http and https prefix test** in `Http/Framing.lean`: + +``` +- !(httpColon.isPrefixOf (h.target.map lower) || httpsColon.isPrefixOf (h.target.map lower)) ++ !(httpColon.isPrefixOf h.target || httpsColon.isPrefixOf h.target) +``` + +**CONNECT not exempt from the http target rule** in `Http/Framing.lean`: + +``` +- h.method == connectName || +- !( ++ !( +``` + +**CONNECT exempt from the http target rule in any case** in `Http/Framing.lean`: + +``` +- h.method == connectName || ++ h.method.map lower == connectName.map lower || +``` + +**https targets not checked** in `Http/Framing.lean`: + +``` +- || httpsColon.isPrefixOf (h.target.map lower) ++ +``` + +**a percent escape's second digit unchecked** in `Http/Grammar.lean`: + +``` +- def pctEncoded : Re := seq [litCI "%", HEXDIG, HEXDIG] ++ def pctEncoded : Re := seq [litCI "%", HEXDIG, range 0x30 0x7A] +``` + +**256 as an IPv4 octet** in `Http/Grammar.lean`: + +``` +- cat (litCI "25") (range 0x30 0x35)] ++ cat (litCI "25") (range 0x30 0x36)] +``` + +**dec-octet 25 then any digit** in `Http/Grammar.lean`: + +``` +- cat (litCI "25") (range 0x30 0x35)] ++ cat (litCI "25") (range 0x30 0x39)] +``` + +**dec-octet 2 then any two digits** in `Http/Grammar.lean`: + +``` +- seq [litCI "2", range 0x30 0x34, DIGIT] ++ seq [litCI "2", range 0x30 0x39, DIGIT] +``` + +**dec-octet with a leading zero** in `Http/Grammar.lean`: + +``` +- cat (range 0x31 0x39) DIGIT ++ cat DIGIT DIGIT +``` + +**dec-octet as 1*3DIGIT** in `Http/Grammar.lean`: + +``` +- def decOctet : Re := +- any [DIGIT, cat (range 0x31 0x39) DIGIT, cat (litCI "1") (rep 2 DIGIT), +- seq [litCI "2", range 0x30 0x34, DIGIT], cat (litCI "25") (range 0x30 0x35)] ++ def decOctet : Re := between 1 3 DIGIT +``` + +**IP literal with a zone ID** in `Http/Grammar.lean`: + +``` +- def IPliteral : Re := seq [litCI "[", alt IPv6address IPvFuture, litCI "]"] ++ def IPliteral : Re := seq [litCI "[", any [IPv6address, seq [IPv6address, litCI "%25", plus (alt unreserved pctEncoded)], IPvFuture], litCI "]"] +``` + +**host may be a bare IPv6 address** in `Http/Grammar.lean`: + +``` +- def host : Re := any [IPliteral, IPv4address, regName] ++ def host : Re := any [IPliteral, IPv6address, IPv4address, regName] +``` + +**IPvFuture v case-sensitive** in `Http/Grammar.lean`: + +``` +- seq [litCI "v", plus HEXDIG ++ seq [byte 0x76, plus HEXDIG +``` diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md new file mode 100644 index 0000000..aa6c618 --- /dev/null +++ b/tests/TEST-RESULTS.md @@ -0,0 +1,33 @@ +# Test results + +Written by `tests/run_tests.py`. Rerun it to check these numbers. + +- Oracle: Python 3.13.17: the grammar and framing rules of RFC 9112, RFC 9110 and RFC 3986 written in this script, with its IPv6 rule checked against `ipaddress` +- Lean: Lean (version 4.35.0, x86_64-unknown-linux-gnu, commit eb6cafb7290e8bd5f2937522d8d804f58f02bafc, Release) +- Seed: 20261025 +- Inputs: 300000 +- Mutated: 104805 of the inputs are mutated heads +- By kind: error 9, fixed 203, mutated 104805, valid 194983 +- Heads read: 211606 of 299991, and 88385 refused by the grammar +- Framing of the heads read: 53665 with no body, 23554 with a length, 10533 chunked, 123854 rejected +- Targets of the heads read: 111186 origin-form, 43301 absolute-form only, 35868 authority-form only, 10984 that fit both absolute-form and authority-form (such as `a:1`), 10267 asterisk-form; 13647 with an IP literal +- Heads read with the method `CONNECT`: 14134. Accepted: 1797. Against the CONNECT rule, and so rejected: 1043 with a host and port target whose host is empty, such as `:443`, 3899 with a host and port target whose host is not empty and whose port is not from 1 to 65535, and 2535 with a target of another form. Rejected only by another rule: 4860 +- Ports of those `CONNECT` targets that are a host and port: 611 empty, 886 zero, 2816 above 65535, 2336 from 1 to 65535 with leading zeros +- Heads read with `connect` or another case of it, which is a different method: 3018, 1095 accepted, 1923 rejected +- Heads read with a target whose scheme is http or https, in any case, and a method other than `CONNECT`: 21234, 10371 of them with upper case in the scheme. Accepted: 6125. Against the rule of RFC 9110 section 4.2, and so rejected: 3085 with no `//` and so no authority, 2532 with an empty host, 2204 with userinfo. Rejected only by another rule: 7288 +- Heads read with `CONNECT` and a target that starts with `http:` or `https:`, in any case: 1821. Of them, 1386 are a host and port, such as `http:80`, which names the host http or https, 239 of them accepted; and 435 are of another form, such as `http://a:80/`, 0 of them accepted +- Heads read with a target of another scheme that fits absolute-form, and a method other than `CONNECT`, which that rule does not cover: 29327, 22111 absolute-form only and 7216 that also fit authority-form, such as `x:443`; 11658 of them with a scheme that starts with `http`, such as `httpx`; 13340 accepted +- Heads read with Transfer-Encoding: 52655. With an empty list element in the combined value: 25747, 6902 chunked and 18845 rejected. With two or more Transfer-Encoding lines: 16435, 3027 chunked and 13408 rejected +- IPv6 literals with an IPv4 tail that is not four dec-octets, anywhere in the input, so also in a field that is not Host: 4837 inputs: 2175 refused by the grammar, 2661 read and rejected, 1 read and accepted +- IP literals with a zone ID (`%` inside the brackets), anywhere in the input: 10181 inputs: 4561 refused by the grammar, 5619 read and rejected, 1 read and accepted +- IPvFuture with an upper-case `V`, anywhere in the input: 7732 inputs: 2407 refused by the grammar, 3109 read and rejected, 2216 read and accepted +- IPvFuture with no hex digit or nothing after the dot, such as `[v.a]` or `[v1.]`, which RFC 3986 does not allow, anywhere in the input: 3597 inputs: 1628 refused by the grammar, 1968 read and rejected, 1 read and accepted +- Host values of the heads read: 212691. Empty: 8107, 4114 of them in an accepted head. With an empty host before a colon, such as `:80` or `:`: 11523, 0 of them in an accepted head +- Host values of the heads read that hold two or more colons and no `[`, such as an IPv6 address with no brackets: 9031, 0 in an accepted head +- IPv6 addresses checked against `ipaddress`, to test the oracle: 20000, of them 1306 with an IPv4 tail that is not four dec-octets; 0 disagreements +- Malformed requests answered `error`: 9 of 9 +- Requests ending in CR LF: every seventh, 42857 +- Inputs also given to `httphead check` on standard input: 2000, and once with no arguments +- Long inputs, each given to `httphead check` on standard input and to `httphead serve`, each run within the time in brackets: a request line of 16 MB (400 s); a field value of 16 MB with a NUL at the end (150 s); a Content-Length of 1,000,000 digits, 1234567890 repeated (30 s); a CONNECT port of 1,000,000 nines (30 s); a CONNECT port of 1,000,000 zeros, then 443 (30 s); a Transfer-Encoding value with 64 KB of spaces after a comma (10 s). Runs answered right in time: 12 of 12 +- A last line with no LF, sent alone, answered right: yes +- Failures: 0 diff --git a/tests/cross_check.py b/tests/cross_check.py new file mode 100644 index 0000000..1667f63 --- /dev/null +++ b/tests/cross_check.py @@ -0,0 +1,820 @@ +#!/usr/bin/env python3 +"""A one-off comparison with three other HTTP/1.1 request parsers. It is +not part of the verified bar. Its record is tests/CROSS-CHECK.md. + +The three parsers: + +- Node's built-in server, with its default strict parser, llhttp + (tests/cross_check/server.js); +- Go's net/http server (tests/cross_check/server.go); +- Python's h11, from .lake/oracle-packages if it is there + (pip install --target .lake/oracle-packages h11). + +The heads are the first `--count` inputs of the differential tests, +less the malformed requests to the tool. Every parser is sent every +head, each on a connection of its own. What is sent is the head: the +octets up to its first empty line, with any empty lines before it. + +After a head this project accepts, the body its framing asks for comes +next. For a Content-Length of N up to 1,000,000, that is N octets. For +chunked, it is `5\\r\\nhello\\r\\n0\\r\\n\\r\\n`, which holds 5 octets of +data. Nothing comes after a head this project rejects, or after a head +with a Content-Length above 1,000,000. Then the client closes its side. + +Each parser is judged on the head: + +- Node and Go accept a head when the servers here answer 2xx. They + answer 2xx once the request has been read. They also answer 2xx when + the client closes before the body ends, or the body holds an error, + and they say which of the three it was. +- llhttp checks the Transfer-Encoding codings only after Node has + passed the request on. When it then stops on them, Node has refused + the head, and the server here answers 400 (see server.js). +- h11 accepts a head when it gives a Request event. +- A parser rejects a head with a 4xx or 5xx answer, or, for h11, with + an error before the Request event. + +So a parser that reads the head and then waits for a body that is never +sent still accepts it. + +Where both accept and a body was sent, the body lengths are compared. +They agree when the parser read as many octets as this project frames, +and its body ended there. Node gives no count for CONNECT, since it +reads what follows the head as a tunnel. + +Where the verdicts differ, the head goes in one category, and it may +be sent again with changes, as below. features() lists the features +the categories name, in order. Apart from the empty lines before the +request line, it looks at the head with those lines removed. A feature +is of one of two kinds: + +- a reason this project rejects the head, such as a bare LF or two Host + lines; +- a feature this project accepts as it is, but another parser may not, + such as empty lines before the request line, or a method other than + the registered ones (GET, HEAD, POST, PUT, DELETE, CONNECT, OPTIONS, + TRACE and PATCH). + +The category is found like this: + +- The parser accepts a head this project rejects: the category is the + first reason this project rejects it. So the parser accepted a head + that has this fault. +- The parser rejects a head this project accepts: the head is sent + again with one accepted feature changed, for example with the empty + lines removed or the method set to GET. Each feature has its own + change, in REPAIRS. The category is the first feature whose change + makes the parser accept. So the parser rejects the head because of + this feature, given the rest of the head. If no single change does + it, the changes are made one more at a time, in order, until the + parser accepts. Then each change the parser still accepts without is + left out, and the category names the ones left. If even all the + changes together do not make the parser accept, the category is + "other". +- The parser gives no answer: the category is the first feature. +- Both accept, but the body lengths differ: the category is the first + accepted feature. + +RFC 9112 lets a recipient repair some of these heads, so a difference +is not always an error. +""" + +import argparse +import re +import socket +import subprocess +import sys +import threading +from pathlib import Path +from typing import NamedTuple, Optional, Tuple + +sys.path.insert(0, str(Path(__file__).resolve().parent)) +import run_tests as rt # noqa: E402 + +ROOT = Path(__file__).resolve().parent.parent +OUT = ROOT / "tests" / "CROSS-CHECK.md" +sys.path.insert(0, str(ROOT / ".lake" / "oracle-packages")) +try: + import h11 +except ImportError: + h11 = None + + +# RFC 9110, section 9, and PATCH (RFC 5789). +REGISTERED_METHODS = {b"GET", b"HEAD", b"POST", b"PUT", b"DELETE", b"CONNECT", b"OPTIONS", b"TRACE", + b"PATCH"} +BODY_LIMIT = 1_000_000 +CHUNKED_BODY = b"5\r\nhello\r\n0\r\n\r\n" +CHUNKED_DATA = 5 +# The two kinds of feature. +REJECTED = "rejected" +ACCEPTED = "accepted" + + +class Answer(NamedTuple): + """A parser's answer to one head. `read` is (octets, how), where how + is "end", "eof" or "error", or None when the answer has no count.""" + accepts: bool + read: Optional[Tuple[int, str]] + detail: bytes + + +def strip_empty(bs): + """`bs` without the empty lines (CRLF) before the request line.""" + i = 0 + while bs[i:i + 2] == b"\r\n": + i += 2 + return bs[i:] + + +def head_part(bs): + """The octets up to the first empty line after the request line, with + any empty lines before it.""" + i = len(bs) - len(strip_empty(bs)) + end = bs.find(b"\r\n\r\n", i) + return bs if end < 0 else bs[:end + 4] + + +def body_for(ours): + """The body to send after the head, and the number of data octets this + project frames in it, or None when there is nothing to compare.""" + if ours is None: + return b"", None + if ours == "chunked": + return CHUNKED_BODY, CHUNKED_DATA + n = int(ours.split()[1]) + if n > BODY_LIMIT: + return b"", None + return b"x" * n, n + + +def parse_answer(resp): + """The Answer in the octets a server sent, or None when they hold no + final status line.""" + while True: + m = re.match(rb"HTTP/1\.[01] ([0-9]{3})[^\r\n]*\r\n", resp) + if not m: + return None + end = resp.find(b"\r\n\r\n") + if end < 0: + return None + if m.group(1).startswith(b"1"): + resp = resp[end + 4:] + continue + status = int(m.group(1)) + x = re.search(rb"\r\nX-Body: *([^\r\n]*)", resp[:end + 2], re.I) + read = None + if x: + w = x.group(1).split() + if len(w) >= 2 and w[0].isdigit(): + read = (int(w[0]), w[1].decode()) + detail = (x.group(1) if x else b"") + b" " + resp[end + 4:end + 84] + return Answer(200 <= status < 300, read, detail.strip()) + + +def ask(port, data, timeout=5): + """The server's Answer to `data`, or None for no answer. The client + sends from a thread of its own and reads at the same time, so an answer + that comes before the server has read all of `data` is still seen.""" + try: + s = socket.create_connection(("127.0.0.1", port), timeout=timeout) + except OSError: + return None + + def send(): + try: + s.sendall(data) + s.shutdown(socket.SHUT_WR) + except OSError: + pass + + t = threading.Thread(target=send, daemon=True) + t.start() + resp = b"" + try: + while True: + chunk = s.recv(65536) + if not chunk: + break + resp += chunk + except OSError: + pass + t.join(timeout) + s.close() + return parse_answer(resp) + + +def h11_verdict(data): + """h11's Answer to `data`, judged on the head as the servers are.""" + conn = h11.Connection(h11.SERVER) + conn.receive_data(data) + conn.receive_data(b"") + try: + ev = conn.next_event() + except h11.RemoteProtocolError as e: + return Answer(False, None, str(e).encode()) + if not isinstance(ev, h11.Request): + return None + n = 0 + try: + while True: + ev = conn.next_event() + if isinstance(ev, h11.Data): + n += len(ev.data) + elif isinstance(ev, h11.EndOfMessage): + return Answer(True, (n, "end"), b"") + else: + return Answer(True, (n, "error"), repr(ev).encode()) + except h11.RemoteProtocolError as e: + # Both of these mean the data ended before the body did. + ended = ("without sending complete message body" in str(e) + or "peer unexpectedly closed connection" in str(e)) + how = "eof" if ended else "error" + return Answer(True, (n, how), str(e).encode()) + + +def verdict(got): + return None if got is None else got.accepts + + +# The features of a head + +EMPTY_LINES = "empty lines before the request line" +OTHER_METHOD = "a method other than the registered ones" +AUTHORITY_FORM = "the authority-form with a method other than CONNECT" +ASTERISK_FORM = "the asterisk-form with a method other than OPTIONS" +HTTP_NO_HOST = "an http or https target with no host" +HTTP_USERINFO = "an http or https target with userinfo" +NO_AUTHORITY = "an absolute-form target with no authority" +MINOR = "HTTP/1.2 to 1.9" +SCHEME_CHARS = "a scheme with a digit, \"+\", \"-\" or \".\"" +HOST_ESCAPE = "a percent escape of an ASCII octet in the host of the target" +TE_EMPTY = "a Transfer-Encoding list with empty elements" +CL_BIG = "a Content-Length of 2^63 or more" +VALUE_TAB = "a tab after a Content-Length or Transfer-Encoding value" +CL_ZEROS = "a Content-Length with leading zeros" +OBS_TEXT = "obs-text in a field value" +EMPTY_HOST = "an empty Host" + + +def te_reason(te): + """Why this project does not read these Transfer-Encoding values as + the one coding chunked. Each element of the list is a coding and its + parameters, `token *( OWS ";" OWS transfer-parameter )` (RFC 9110, + section 10.1.4), so the coding names are compared without them. RFC + 9112 section 7.1 says the chunked coding has no parameters, and + "Their presence SHOULD be treated as an error".""" + elements = [e.strip(b" \t") for e in rt.combined(te).split(b",")] + elements = [e for e in elements if e] + codings = [e.split(b";", 1)[0].rstrip(b" \t").lower() for e in elements] + if not codings: + cat = "a Transfer-Encoding with no coding" + elif codings.count(b"chunked") > 1: + cat = "chunked twice" + elif codings[-1] != b"chunked": + cat = "a Transfer-Encoding whose last coding is not chunked" + elif len(codings) > 1: + cat = "a Transfer-Encoding with another coding before chunked" + elif b";" in elements[-1]: + cat = "chunked with a parameter" + else: + cat = "another Transfer-Encoding" + return cat + (", over two or more lines" if len(te) > 1 else "") + + +def http_reason(method, target): + """Why this project rejects a target of the grammar under RFC 9110, + sections 4.2.1, 4.2.2 and 4.2.4, or None. The rule is for a target + whose scheme is http or https, in any case, with a method other than + CONNECT. Such a target needs "//" and a host that is not empty, and + its authority may not hold userinfo. With no "//" it has no host. A + target with userinfo and an empty host, such as `http://u@/`, is + counted as one with userinfo.""" + scheme, colon, rest = target.partition(b":") + if method == b"CONNECT" or not colon or scheme.lower() not in (b"http", b"https"): + return None + if not rest.startswith(b"//"): + return HTTP_NO_HOST + authority = re.match(rb"//([^/?#]*)", rest).group(1) + if b"@" in authority: + return HTTP_USERINFO + host = authority + if not host.startswith(b"["): + host = host.partition(b":")[0] + return HTTP_NO_HOST if host == b"" else None + + +def target_host(method, target): + """(start, end) of the host in a target of the grammar, or None when + the target has no host.""" + if method == b"CONNECT" or (re.fullmatch(rt.AUTHORITY_FORM, target) + and not re.fullmatch(rt.ABSOLUTE_URI, target)): + return 0, target.rfind(b":") + m = re.match(rt.SCHEME + rb"://([^/?#]*)", target) + if not m or target.startswith(b"/"): + return None + start = m.start(1) + m.group(1).rfind(b"@") + 1 + if target[start:start + 1] == b"[": + return start, target.index(b"]", start) + 1 + colon = target.find(b":", start, m.end(1)) + return start, colon if colon >= 0 else m.end(1) + + +def without_host_escapes(bs): + """`bs` with each percent escape of an ASCII octet in the host of its + target replaced by `x`.""" + method, target, version = split_head(bs)[1].split(b" ") + a, b = target_host(method, target) + host = re.sub(rb"%[0-7][0-9A-Fa-f]", b"x", target[a:b]) + return change_request_line(bs, target=target[:a] + host + target[b:]) + + +def field_name(line): + return line.split(b":", 1)[0].lower() + + +def framing_field(line): + return field_name(line) in (b"content-length", b"transfer-encoding") + + +def value_after_ows(line): + """A field line's value with the whitespace before it removed, and + the whitespace after it kept.""" + return line.split(b":", 1)[1].lstrip(b" \t") + + +def features(bs): + """The features of the head that the categories name, in order, as + (kind, name). The list ends at the first reason this project rejects + the head.""" + h = head_part(bs) + head = rt.reference(bs) + if re.search(rb"(? 1: + reason = "two Content-Length lines" + (" with the same value" if len(set(cl)) == 1 + else " with different values") + elif cl and not re.fullmatch(rb"[0-9]+", cl[0]): + values = [v.strip(b" \t") for v in cl[0].split(b",")] + if len(values) > 1 and all(re.fullmatch(rb"[0-9]+", v) for v in values) \ + and len({int(v) for v in values}) == 1: + reason = "a Content-Length list of equal values" + else: + reason = "a Content-Length that is not digits" + elif len(hosts) > 1: + reason = "two Host lines" + elif head[3] >= 1 and not hosts: + reason = "no Host, in HTTP/1.1 to 1.9" + elif hosts and not rt.host_ok(hosts[0]): + if rt.HOST_FIELD.fullmatch(hosts[0]): + reason = "a Host value with an empty host, such as `:80`" + elif b"[" in hosts[0] or b"]" in hosts[0] or hosts[0].count(b":") > 1: + reason = "a Host value with a bad IP literal" + else: + reason = "another Host value outside RFC 3986" + if reason: + yield REJECTED, reason + return + if te and len([e for e in rt.combined(te).split(b",")]) > 1: + yield ACCEPTED, TE_EMPTY + if cl and int(cl[0]) >= 2 ** 63: + yield ACCEPTED, CL_BIG + if any(b"\t" in value_after_ows(line) for line in fields if framing_field(line)): + yield ACCEPTED, VALUE_TAB + if cl and len(cl[0]) > 1 and cl[0].startswith(b"0"): + yield ACCEPTED, CL_ZEROS + if any(re.search(rb"[\x80-\xff]", v) for _, v in head[4]): + yield ACCEPTED, OBS_TEXT + if hosts and hosts[0] == b"": + yield ACCEPTED, EMPTY_HOST + + +# Repairs: each changes one accepted feature of a head and keeps the rest. + +def split_head(bs): + """(empty lines, request line, field lines, the rest from the empty + line that ends the head).""" + i = len(bs) - len(strip_empty(bs)) + end = bs.find(b"\r\n\r\n", i) + lines = bs[i:end].split(b"\r\n") + return bs[:i], lines[0], lines[1:], bs[end:] + + +def join_head(prefix, request_line, fields, rest): + return prefix + b"\r\n".join([request_line] + fields) + rest + + +def change_request_line(bs, method=None, target=None, version=None): + prefix, request_line, fields, rest = split_head(bs) + m, t, v = request_line.split(b" ") + return join_head(prefix, b" ".join([method or m, target or t, version or v]), fields, rest) + + +def change_fields(bs, f): + """`bs` with each field line replaced by the lines f gives for it.""" + prefix, request_line, fields, rest = split_head(bs) + return join_head(prefix, request_line, [out for line in fields for out in f(line)], rest) + + +def one_chunked(bs): + """`bs` with its Transfer-Encoding lines replaced by one line that holds + only chunked.""" + seen = [] + + def f(line): + if field_name(line) != b"transfer-encoding": + return [line] + if seen: + return [] + seen.append(line) + return [b"Transfer-Encoding: chunked"] + return change_fields(bs, f) + + +def content_length(g): + def f(line): + if field_name(line) != b"content-length": + return [line] + name, value = line.split(b":", 1) + return [name + b":" + g(value)] + return f + + +REPAIRS = { + EMPTY_LINES: strip_empty, + MINOR: lambda bs: change_request_line(bs, version=b"HTTP/1.1"), + AUTHORITY_FORM: lambda bs: change_request_line(bs, target=b"/"), + ASTERISK_FORM: lambda bs: change_request_line(bs, target=b"/"), + # Only the method changes. When the target is `*` or a host and port, + # its own feature comes first, so a parser that also wants another + # target for GET gets the two changes together. + OTHER_METHOD: lambda bs: change_request_line(bs, method=b"GET"), + NO_AUTHORITY: lambda bs: change_request_line(bs, target=b"/"), + SCHEME_CHARS: lambda bs: change_request_line( + bs, target=b"x:" + split_head(bs)[1].split(b" ")[1].split(b":", 1)[1]), + HOST_ESCAPE: without_host_escapes, + TE_EMPTY: one_chunked, + CL_BIG: lambda bs: change_fields(bs, content_length(lambda v: b" 0")), + VALUE_TAB: lambda bs: change_fields(bs, lambda line: [ + line.split(b":", 1)[0] + b": " + value_after_ows(line).replace(b"\t", b" ") + if framing_field(line) else line]), + CL_ZEROS: lambda bs: change_fields(bs, content_length( + lambda v: b" " + str(int(v.strip(b" \t"))).encode())), + OBS_TEXT: lambda bs: change_fields(bs, lambda line: [re.sub(rb"[\x80-\xff]", b"x", line)]), + EMPTY_HOST: lambda bs: change_fields( + bs, lambda line: [b"Host: a" if field_name(line) == b"host" else line]), +} + + +def file_difference(fn, bs, body, got, how): + """The category of a difference, as the module docstring says.""" + found = list(features(bs)) + accepted = [name for kind, name in found if kind == ACCEPTED] + if how == "accepts": + rejected = [name for kind, name in found if kind == REJECTED] + return rejected[0] if rejected else "other" + if how != "rejects": + return found[0][1] if found else "other" + for name in accepted: + if verdict(fn(head_part(REPAIRS[name](bs)) + body)) != verdict(got): + return name + # No single change: change the features one more at a time until the + # parser accepts, then leave out each change it still accepts without. + def flips(names): + fixed = bs + for name in names: + # An earlier change can take a later feature away too. + if any(n == name for _, n in features(fixed)): + fixed = REPAIRS[name](fixed) + return verdict(fn(head_part(fixed) + body)) != verdict(got) + + for k in range(2, len(accepted) + 1): + if flips(accepted[:k]): + needed = accepted[:k] + for name in accepted[:k - 1]: + fewer = [n for n in needed if n != name] + if flips(fewer): + needed = fewer + return "together: " + "; ".join(needed) + return "other" + + +def compare(fn, items): + """Send every head to one parser, and count how its answers compare + with this project's.""" + r = {"sent": 0, "both_accept": 0, "both_reject": 0, "they_accept": 0, "they_reject": 0, + "no_answer": 0, "compared": 0, "compared_zero": 0, "compared_chunked": 0, + "compared_length": 0, "same_length": 0, "other_length": 0, "over_limit": 0, + "no_count": 0, "cats": {}} + for bs in items: + head = rt.reference(bs) + ours = rt.framing(head) if head else None + body, expect = body_for(ours) + got = fn(head_part(bs) + body) + r["sent"] += 1 + accepted = ours is not None + if got is None or got.accepts != accepted: + if got is None: + r["no_answer"] += 1 + how = "no answer" + elif got.accepts: + r["they_accept"] += 1 + how = "accepts" + else: + r["they_reject"] += 1 + how = "rejects" + cat = file_difference(fn, bs, body, got, how) + r["cats"].setdefault((how, cat), []).append((bs, got)) + continue + if not accepted: + r["both_reject"] += 1 + continue + r["both_accept"] += 1 + if expect is None: + r["over_limit"] += 1 + continue + if got.read is None: + r["no_count"] += 1 + continue + r["compared"] += 1 + if expect == 0: + r["compared_zero"] += 1 + elif ours == "chunked": + r["compared_chunked"] += 1 + else: + r["compared_length"] += 1 + n, end = got.read + if end == "end" and n == expect: + r["same_length"] += 1 + continue + r["other_length"] += 1 + if end == "eof": + how = f"reads the head, then waits for a longer body ({n} octets read)" + elif end == "error": + how = "reads the head, then finds an error in the body" + else: + how = f"reads {n} body octets where this project frames {expect}" + accepted_features = [name for kind, name in features(bs) if kind == ACCEPTED] + cat = accepted_features[0] if accepted_features else "other" + r["cats"].setdefault((how, cat), []).append((bs, got)) + return r + + +def start(cmd): + proc = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.DEVNULL, text=True) + port = int(proc.stdout.readline()) + return proc, port + + +def example(bs): + """The head as sent, without the body, for a table cell.""" + return f"`{head_part(bs)[:100]!r}`".replace("|", "\\|") + + +def main(): + ap = argparse.ArgumentParser() + ap.add_argument("--count", type=int, default=6000) + ap.add_argument("--seed", type=int, default=20261025) + args = ap.parse_args() + + gobin = ROOT / ".lake" / "cross_check" / "server" + gobin.parent.mkdir(parents=True, exist_ok=True) + subprocess.run(["go", "build", "-o", str(gobin), str(ROOT / "tests" / "cross_check" / "server.go")], + check=True) + node_ver = subprocess.run(["node", "--version"], capture_output=True, text=True).stdout.strip() + go_ver = subprocess.run(["go", "version"], capture_output=True, text=True).stdout.strip() + servers = {} + procs = [] + p, port = start(["node", str(ROOT / "tests" / "cross_check" / "server.js")]) + procs.append(p) + servers[f"Node {node_ver} (llhttp)"] = lambda d, port=port: ask(port, d) + p, port = start([str(gobin)]) + procs.append(p) + servers[f"Go {go_ver.split()[2]} net/http"] = lambda d, port=port: ask(port, d) + if h11: + servers[f"h11 {h11.__version__}"] = h11_verdict + + items = [bytes.fromhex(req.split(" ")[1]) + for label, req, _, _ in rt.cases(args.seed, args.count) if label != "error"] + # features() must name a reason to reject in exactly the heads this + # project rejects, and each repair must keep a head this project accepts. + for bs in items: + head = rt.reference(bs) + ours = rt.framing(head) if head else None + found = list(features(bs)) + if (ours is None) != any(kind == REJECTED for kind, _ in found): + sys.exit(f"features() does not match this project's verdict on {bs!r}") + for kind, name in found: + fixed = REPAIRS[name](bs) if ours is not None else None + if fixed is not None and (rt.reference(fixed) is None + or rt.framing(rt.reference(fixed)) is None): + sys.exit(f"the repair for {name!r} makes this project reject {bs!r}") + try: + report = {name: compare(fn, items) for name, fn in servers.items()} + finally: + for p in procs: + p.kill() + + ours = {"reject": 0, "none": 0, "length": 0, "chunked": 0, "over": 0} + for bs in items: + head = rt.reference(bs) + fr = rt.framing(head) if head else None + if fr is None: + ours["reject"] += 1 + elif fr == "chunked": + ours["chunked"] += 1 + elif fr == "length 0": + ours["none"] += 1 + elif int(fr.split()[1]) <= BODY_LIMIT: + ours["length"] += 1 + else: + ours["over"] += 1 + + lines = ["# Cross-check with other HTTP parsers", "", + "Written by `tests/cross_check.py`, a one-off comparison that is not part of the " + "verified bar. Its docstring says how the heads are sent and judged, and how a " + "difference gets its category. RFC 9112 lets a recipient repair some malformed " + "heads instead of rejecting them, so a difference here is a different choice, not " + "always an error.", "", + f"- Heads: the first {len(items)} inputs of the differential tests (seed {args.seed}, " + f"`--count {args.count}`, less the malformed requests to the tool). Every parser is " + f"sent all {len(items)}. A head whose verdicts differ is also sent again with " + f"features changed, to find its category.", + f"- This project rejects {ours['reject']} of them. It accepts {ours['none']} with no " + f"body, {ours['length']} with a Content-Length from 1 to {BODY_LIMIT:,}, " + f"{ours['chunked']} as chunked, and {ours['over']} with a Content-Length above " + f"{BODY_LIMIT:,}.", + f"- Sent after the head: nothing after a head this project rejects; the whole body " + f"for a Content-Length up to {BODY_LIMIT:,}; `5\\r\\nhello\\r\\n0\\r\\n\\r\\n` " + f"(5 octets of data) for chunked; nothing for a Content-Length above " + f"{BODY_LIMIT:,}, so those heads are judged on the head alone.", + "- A parser accepts a head when it reads it and passes the request on, even when " + "it then waits for a body that is never sent.", + "- In the tables, \"accepts\" means the other parser accepts a head this project " + "rejects, and \"rejects\" means it rejects a head this project accepts. The " + "examples show the head as sent, cut at 100 octets.", + "- Categories: for a head the other parser accepts, the first reason this project " + "rejects it. For a head the other parser rejects, the first feature whose change " + "alone makes that parser accept it, or, after \"together:\", the features whose " + "changes it needs at once. The script checks that it finds a reason to reject in " + "each head this project rejects and in no other, and that each change keeps a head " + "this project accepts.", ""] + for name, r in report.items(): + nonzero = r["compared_chunked"] + r["compared_length"] + lines += [f"## {name}", "", + f"- Heads sent: {r['sent']}", + f"- Same verdict: {r['both_accept'] + r['both_reject']} " + f"({r['both_accept']} both accept, {r['both_reject']} both reject)", + f"- Different verdict: {r['they_accept'] + r['they_reject']} " + f"({r['they_accept']} it accepts and this project rejects, " + f"{r['they_reject']} it rejects and this project accepts)", + f"- No answer: {r['no_answer']}", + f"- Body lengths compared, where both accept: {r['compared']}. Of those, " + f"{r['compared_zero']} have no body and {nonzero} a non-zero length " + f"({r['compared_length']} by Content-Length, {r['compared_chunked']} chunked). " + f"{r['same_length']} read the same length and {r['other_length']} another.", + f"- Not compared, where both accept: {r['over_limit']} with a Content-Length " + f"above {BODY_LIMIT:,}, and {r['no_count']} whose answer has no count.", ""] + alone, together = {}, {} + for (how, cat), found in r["cats"].items(): + if how != "rejects": + continue + if cat.startswith("together: "): + for name in cat[len("together: "):].split("; "): + together[name] = together.get(name, 0) + len(found) + else: + alone[cat] = alone.get(cat, 0) + len(found) + if alone or together: + lines += ["The heads it rejects and this project accepts, by the feature whose change " + "makes it accept them: alone, or together with other changes.", "", + "| Feature | Alone | With others |", "| --- | --- | --- |"] + for name in sorted(set(alone) | set(together), + key=lambda n: (-alone.get(n, 0) - together.get(n, 0), n)): + lines.append(f"| {name} | {alone.get(name, 0)} | {together.get(name, 0)} |") + lines.append("") + if r["cats"]: + lines += ["Where it differs from this project (the two shortest examples):", "", + "| It | Category | Heads | Examples |", "| --- | --- | --- | --- |"] + for (how, cat), found in sorted(r["cats"].items(), key=lambda kv: (-len(kv[1]), kv[0])): + shortest = sorted({head_part(bs) for bs, _ in found}, key=lambda b: (len(b), b))[:2] + ex = ", ".join(example(b) for b in shortest) + lines.append(f"| {how} | {cat} | {len(found)} | {ex} |") + lines.append("") + OUT.write_text("\n".join(lines), encoding="utf-8") + print(f"{len(items)} heads; report in {OUT}") + + +if __name__ == "__main__": + main() diff --git a/tests/cross_check/server.go b/tests/cross_check/server.go new file mode 100644 index 0000000..2e7d383 --- /dev/null +++ b/tests/cross_check/server.go @@ -0,0 +1,43 @@ +// A Go net/http server. It prints its port first. It answers 200 to +// each request whose head it reads, with an X-Body field that says how +// many body octets it read and how the body ended: +// - "N end": the body ended where Go's framing says it ends; +// - "N eof": the client closed its side before that; +// - "N error": Go found an error in the body. +// +// Go itself answers 400 when it refuses the head. Requests for +// "OPTIONS *" also come to this handler. +package main + +import ( + "errors" + "fmt" + "io" + "net" + "net/http" + "os" +) + +func main() { + ln, err := net.Listen("tcp", "127.0.0.1:0") + if err != nil { + fmt.Fprintln(os.Stderr, err) + os.Exit(1) + } + fmt.Println(ln.Addr().(*net.TCPAddr).Port) + srv := &http.Server{ + DisableGeneralOptionsHandler: true, + Handler: http.HandlerFunc(func(w http.ResponseWriter, r *http.Request) { + b, err := io.ReadAll(r.Body) + how := "end" + if errors.Is(err, io.ErrUnexpectedEOF) { + how = "eof" + } else if err != nil { + how = "error" + } + w.Header().Set("Connection", "close") + w.Header().Set("X-Body", fmt.Sprintf("%d %s", len(b), how)) + }), + } + srv.Serve(ln) +} diff --git a/tests/cross_check/server.js b/tests/cross_check/server.js new file mode 100644 index 0000000..5b986e9 --- /dev/null +++ b/tests/cross_check/server.js @@ -0,0 +1,52 @@ +// A Node HTTP server with its default, strict parser (llhttp). It prints +// its port first. It answers 200 to each request whose head it reads, +// with an X-Body field that says how many body octets it read and how +// the body ended: +// - "N end": the body ended where Node's framing says it ends; +// - "N eof": the client closed its side before that; +// - "N error CODE": llhttp found an error in the body. +// It answers 400 when llhttp refuses the head itself. Node hands a +// CONNECT request to the 'connect' event and reads what follows as a +// tunnel, not a body, so that answer says "tunnel". +// +// llhttp checks Transfer-Encoding just after Node has passed the request +// on. When the last coding is not chunked, it then stops with +// HPE_INVALID_TRANSFER_ENCODING. That is a refusal of the head, so it +// gets 400 too. +const http = require('http'); + +// The sockets whose request head was read and not yet answered, each +// with a function that gives the body octets read so far. +const reading = new Map(); + +function write(socket, status, xbody) { + if (!socket.writable) return; + socket.end(`HTTP/1.1 ${status}\r\nX-Body: ${xbody}\r\nContent-Length: 0\r\n` + + 'Connection: close\r\n\r\n'); +} + +const srv = http.createServer((req, res) => { + let n = 0; + reading.set(req.socket, () => n); + req.on('data', (c) => { n += c.length; }); + req.on('end', () => { + reading.delete(req.socket); + res.writeHead(200, { Connection: 'close', 'X-Body': `${n} end`, 'Content-Length': 0 }); + res.end(); + }); +}); +srv.on('connect', (req, socket) => { + write(socket, '200 OK', 'tunnel'); +}); +srv.on('clientError', (err, socket) => { + const read = reading.get(socket); + reading.delete(socket); + if (read && err.code !== 'HPE_INVALID_TRANSFER_ENCODING') { + const how = err.code === 'HPE_INVALID_EOF_STATE' ? 'eof' : `error ${err.code}`; + write(socket, '200 OK', `${read()} ${how}`); + } else { + write(socket, '400 Bad Request', `none ${err.code}`); + } + socket.destroySoon(); +}); +srv.listen(0, '127.0.0.1', () => console.log(srv.address().port)); diff --git a/tests/planted_bugs.py b/tests/planted_bugs.py new file mode 100644 index 0000000..3f451c5 --- /dev/null +++ b/tests/planted_bugs.py @@ -0,0 +1,273 @@ +#!/usr/bin/env python3 +"""Plant each bug below in a copy of the code, and check the tests catch it. + +A planted bug is a small change to the code under proof, of a kind a +person could make by mistake. For each one, this script copies the +project into a temporary directory, makes the change there, builds the +command-line tool, and runs the differential tests on a given number of +inputs. The tests catch the bug when they report failures. A change +that alters an answer of the code under proof also breaks the proofs, +since the code no longer meets its statements. This script checks the +tests on their own, so it builds only the tool, not the proofs. + +The project itself is never changed. The script writes the results to +tests/PLANTED-BUGS.md, and exits with 1 if a bug is not caught and is +not marked as equivalent. An equivalent change gives the same answer on +every input, so no test can catch it; its entry says why. + +Usage: python3 tests/planted_bugs.py [--count N] +""" + +import argparse +import re +import shutil +import subprocess +import sys +import tempfile +from pathlib import Path + +ROOT = Path(__file__).resolve().parent.parent +EXE = "httphead" # the lake target of the command-line tool +COUNT = 300_000 + +TE_ANY_LINES = (" | t :: ts, [] =>\n" + " if 1 ≤ h.minor && Grammar.chunkedList.isMatch (List.intercalate [0x2C] " + "((t :: ts).map (·.value)))\n") +LIST_ONE = ' seq [star (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])]' +DEC_OCTET = ('def decOctet : Re :=\n' + ' any [DIGIT, cat (range 0x31 0x39) DIGIT, cat (litCI "1") (rep 2 DIGIT),\n' + ' seq [litCI "2", range 0x30 0x34, DIGIT], cat (litCI "25") (range 0x30 0x35)]') +HTTP_PREFIX = ("!(httpColon.isPrefixOf (h.target.map lower) || " + "httpsColon.isPrefixOf (h.target.map lower))") + +# Why the two equivalent changes give the same answer on every input. +BARE_CR = ( + "the code gives `none` for a CR that is not followed by LF, and the change keeps that CR in " + "the line instead. Every line is then read by parseHead or parseField, and neither accepts a " + "CR: not in the method (a token), the target (no rule of the target grammar has 0x0D), the " + "version (exactly `HTTP/` digit `.` digit), a field name (a token) or a field value (trim " + "removes only SP and HTAB, and isFieldValue allows only field-vchar, SP and HTAB). A line " + "holding a CR is not empty, so it never ends the head. So parseHead gives `none` in both, " + "and on every other input the code is the same") +UPPER_NAMES = ( + "on every head that parseHead gives, the only heads the tool frames, it matches the same " + "fields. `n.map (c - 0x20)` is `HOST` for `host`, which the first test already matches. For " + "`content-length` and `transfer-encoding` it turns `-` (0x2D) into CR (0x0D), and a field " + "name is a token, so it never holds a CR. The proof of framing_iff, which covers every " + "Head, would catch it; the tests cannot") + +CONNECT_EMPTY_HOST = ( + "`hostNonEmpty` and `uriHost` differ only on the empty host, so the change lets through only " + "a CONNECT target that begins with `:`. `Head.framing` refuses every target that begins with " + "`:` (an authority-form target with an empty host, RFC 9112 section 3.3), for any method, so " + "the answer is the same on every input") + +# (name, file, text to replace, replacement, why it is equivalent or None) +BUGS = [ + # The head + ("bare LF ends a line", "Http/Head.lean", " else if c == 0x0A then none\n", + " else if c == 0x0A then some ([], rest)\n", None), + ("bare CR kept in a line", "Http/Head.lean", + " | d :: rest' => if d == 0x0A then some (acc.reverse, rest') else none", + " | d :: rest' => if d == 0x0A then some (acc.reverse, rest') else " + "takeLineFrom (c :: acc) rest", BARE_CR), + ("space before colon dropped", "Http/Head.lean", " let name := line.takeWhile (· != 0x3A)\n", + " let name := (line.takeWhile (· != 0x3A)).filter (· != 0x20)\n", None), + ("trailing whitespace kept", "Http/Head.lean", " ((v.dropWhile isWs).reverse.dropWhile isWs).reverse", + " v.dropWhile isWs", None), + ("NUL allowed in a value", "Http/Head.lean", + "def isVchar (c : UInt8) : Bool := (0x21 ≤ c && c ≤ 0x7E) || 0x80 ≤ c", + "def isVchar (c : UInt8) : Bool := (0x21 ≤ c && c ≤ 0x7E) || 0x80 ≤ c || c == 0", None), + ("a double quote in a token", "Http/Head.lean", " 0x60, 0x7C, 0x7E].contains c", + " 0x60, 0x7C, 0x7E, 0x22].contains c", None), + ("empty lines first not skipped", "Http/Head.lean", + " | c :: d :: rest => if c == 0x0D && d == 0x0A then skipEmpty rest else c :: d :: rest", + " | c :: d :: rest => c :: d :: rest", None), + ("minor version digit unchecked", "Http/Head.lean", " isDigit a && isDigit b then", + " isDigit a then", None), + # Host, version and Content-Length + ("Host not required in HTTP/1.1", "Http/Framing.lean", " || (1 ≤ h.minor && hosts.length != 1)", "", + None), + ("two Host lines accepted", "Http/Framing.lean", " || hosts.length > 1", "", None), + ("upper-case field names matched twice", "Http/Framing.lean", + "def Field.isNamed (f : Field) (n : List UInt8) : Bool := f.name.map lower == n", + "def Field.isNamed (f : Field) (n : List UInt8) : Bool := f.name.map lower == n || " + "f.name == n.map (fun c => c - 0x20)", UPPER_NAMES), + ("any major version accepted", "Http/Framing.lean", " if h.major != 1 ||", " if", None), + ("first of several Content-Length taken", "Http/Framing.lean", " | [], [f] => if", + " | [], f :: _ => if", None), + ("Content-Length and port digits read backwards", "Http/Framing.lean", + "def decimal (ds : List UInt8) : Nat := ds.foldl (fun n d => 10 * n + (d.toNat - 0x30)) 0", + "def decimal (ds : List UInt8) : Nat := ds.foldr (fun d n => 10 * n + (d.toNat - 0x30)) 0", None), + # Transfer-Encoding + ("Transfer-Encoding overrides Content-Length", "Http/Framing.lean", " | _, _ => none\n", + " | t :: ts, _ =>\n" + " if 1 ≤ h.minor && Grammar.chunkedList.isMatch (List.intercalate [0x2C] " + "((t :: ts).map (·.value)))\n" + " then some .chunked else none\n" + " | _, _ => none\n", None), + ("Transfer-Encoding in HTTP/1.0 accepted", "Http/Framing.lean", + "if 1 ≤ h.minor && Grammar.chunkedList.isMatch", "if Grammar.chunkedList.isMatch", None), + ("chunked compared case-sensitively", "Http/Grammar.lean", 'def chunkedList : Re := listOne (litCI "chunked")', + 'def chunkedList : Re := listOne (lit "chunked")', None), + ("list: no empty elements before chunked", "Http/Grammar.lean", LIST_ONE, + ' seq [e, star (seq [OWS, litCI ",", OWS])]', None), + ("list: no empty elements after chunked", "Http/Grammar.lean", LIST_ONE, + ' seq [star (seq [OWS, litCI ",", OWS]), e]', None), + ("list: at most one empty element before chunked", "Http/Grammar.lean", LIST_ONE, + ' seq [opt (seq [OWS, litCI ",", OWS]), e, star (seq [OWS, litCI ",", OWS])]', None), + ("list: a tab is not OWS", "Http/Grammar.lean", "def OWS : Re := star (alt SP HTAB)", + "def OWS : Re := star SP", None), + ("Transfer-Encoding only as one field line", "Http/Framing.lean", TE_ANY_LINES, + " | [t], [] =>\n if 1 ≤ h.minor && Grammar.chunkedList.isMatch t.value\n", None), + ("only the first Transfer-Encoding line read", "Http/Framing.lean", "((t :: ts).map (·.value))", + "([t].map (·.value))", None), + ("Transfer-Encoding lines joined with no comma", "Http/Framing.lean", "List.intercalate [0x2C]", + "List.intercalate []", None), + # CONNECT + ("CONNECT rule removed", "Http/Framing.lean", "!h.connectOK || ", "", None), + ("CONNECT port up to 65536", "Http/Framing.lean", "decimal ds ≤ 65535 else false", + "decimal ds ≤ 65536 else false", None), + ("CONNECT port 0 and empty port accepted", "Http/Framing.lean", "then 1 ≤ decimal ds &&", + "then 0 ≤ decimal ds &&", None), + ("CONNECT port 0 accepted", "Http/Framing.lean", "portInRange (portOf h.target))", + "(portInRange (portOf h.target) || (!(portOf h.target).isEmpty && " + "(portOf h.target).all (· == 0x30))))", None), + ("CONNECT port limited to five digits", "Http/Framing.lean", + "then 1 ≤ decimal ds && decimal ds ≤ 65535 else false", "then 1 ≤ decimal ds else false", None), + ("CONNECT port leading zeros counted as digits", "Http/Framing.lean", + " let ds := ds.dropWhile (· == 0x30)\n", "", None), + ("CONNECT method compared case-insensitively", "Http/Framing.lean", " h.method != connectName ||", + " h.method.map lower != connectName.map lower ||", None), + ("CONNECT target form unchecked", "Http/Framing.lean", + " (Grammar.connectTarget.isMatch h.target && portInRange", " (portInRange", None), + ("CONNECT target may have an empty host", "Http/Grammar.lean", + "def connectTarget : Re := seq [hostNonEmpty, litCI \":\", port]", + "def connectTarget : Re := seq [uriHost, litCI \":\", port]", CONNECT_EMPTY_HOST), + # An authority-form target with an empty host, and CONNECT content + ("empty host allowed in an authority-form target", "Http/Framing.lean", + "h.target.head? == some 0x3A || ", "", None), + ("CONNECT content accepted", "Http/Framing.lean", + " || (h.method == connectName && fr != .length 0)", "", None), + ("CONNECT with Content-Length accepted", "Http/Framing.lean", + "(h.method == connectName && fr != .length 0)", "(h.method == connectName && fr == .chunked)", None), + ("CONNECT content rule in any case of the method", "Http/Framing.lean", + "(h.method == connectName && fr != .length 0)", + "(h.method.map lower == connectName.map lower && fr != .length 0)", None), + # The Host value + ("empty host allowed in a Host value", "Http/Grammar.lean", + "def hostField : Re := opt (cat hostNonEmpty (opt (cat (litCI \":\") port)))", + "def hostField : Re := opt (cat host (opt (cat (litCI \":\") port)))", None), + ("CONNECT port read from every digit", "Http/Framing.lean", + "def portOf (t : List UInt8) : List UInt8 := (t.reverse.takeWhile isDigit).reverse", + "def portOf (t : List UInt8) : List UInt8 := t.filter isDigit", None), + # http and https targets + ("http target rule removed", "Http/Framing.lean", " || !h.httpTargetOK", "", None), + ("userinfo allowed in an http target", "Http/Grammar.lean", 'litCI "://", hostNonEmpty,', + 'litCI "://", opt (cat userinfo (litCI "@")), hostNonEmpty,', None), + ("empty host allowed in an http target (reg-name star)", "Http/Grammar.lean", + "plus (any [unreserved, pctEncoded, subDelims])", "star (any [unreserved, pctEncoded, subDelims])", + None), + ("scheme compared case-sensitively in the http target grammar", "Http/Grammar.lean", + 'alt (litCI "http") (litCI "https")', 'alt (lit "http") (lit "https")', None), + ("scheme compared case-sensitively in the http and https prefix test", "Http/Framing.lean", + HTTP_PREFIX, "!(httpColon.isPrefixOf h.target || httpsColon.isPrefixOf h.target)", None), + ("CONNECT not exempt from the http target rule", "Http/Framing.lean", + " h.method == connectName ||\n !(", " !(", None), + ("CONNECT exempt from the http target rule in any case", "Http/Framing.lean", + " h.method == connectName ||", " h.method.map lower == connectName.map lower ||", None), + ("https targets not checked", "Http/Framing.lean", + " || httpsColon.isPrefixOf (h.target.map lower)", "", None), + # The target and Host grammar + ("a percent escape's second digit unchecked", "Http/Grammar.lean", + 'def pctEncoded : Re := seq [litCI "%", HEXDIG, HEXDIG]', + 'def pctEncoded : Re := seq [litCI "%", HEXDIG, range 0x30 0x7A]', None), + ("256 as an IPv4 octet", "Http/Grammar.lean", 'cat (litCI "25") (range 0x30 0x35)]', + 'cat (litCI "25") (range 0x30 0x36)]', None), + ("dec-octet 25 then any digit", "Http/Grammar.lean", 'cat (litCI "25") (range 0x30 0x35)]', + 'cat (litCI "25") (range 0x30 0x39)]', None), + ("dec-octet 2 then any two digits", "Http/Grammar.lean", 'seq [litCI "2", range 0x30 0x34, DIGIT]', + 'seq [litCI "2", range 0x30 0x39, DIGIT]', None), + ("dec-octet with a leading zero", "Http/Grammar.lean", "cat (range 0x31 0x39) DIGIT", "cat DIGIT DIGIT", + None), + ("dec-octet as 1*3DIGIT", "Http/Grammar.lean", DEC_OCTET, "def decOctet : Re := between 1 3 DIGIT", + None), + ("IP literal with a zone ID", "Http/Grammar.lean", + 'def IPliteral : Re := seq [litCI "[", alt IPv6address IPvFuture, litCI "]"]', + 'def IPliteral : Re := seq [litCI "[", any [IPv6address, seq [IPv6address, litCI "%25", ' + 'plus (alt unreserved pctEncoded)], IPvFuture], litCI "]"]', None), + ("host may be a bare IPv6 address", "Http/Grammar.lean", + "def host : Re := any [IPliteral, IPv4address, regName]", + "def host : Re := any [IPliteral, IPv6address, IPv4address, regName]", None), + ("IPvFuture v case-sensitive", "Http/Grammar.lean", 'seq [litCI "v", plus HEXDIG', + "seq [byte 0x76, plus HEXDIG", None), +] + + +def failures(out): + m = re.search(r"(\d+) failures?", out) + return int(m.group(1)) if m else None + + +def run(count): + rows = [] + with tempfile.TemporaryDirectory() as tmp: + work = Path(tmp) / "project" + shutil.copytree(ROOT, work, ignore=shutil.ignore_patterns(".git")) + for name, rel, old, new, equivalent in BUGS: + path = work / rel + original = (ROOT / rel).read_text() + if original.count(old) != 1: + sys.exit(f"{name}: the text to replace is not in {rel} exactly once") + path.write_text(original.replace(old, new)) + build = subprocess.run(["lake", "build", EXE], cwd=work, capture_output=True, text=True) + if build.returncode != 0: + path.write_text(original) + sys.exit(f"{name}: the tool does not build with this change\n{build.stdout[-2000:]}") + test = subprocess.run([sys.executable, "tests/run_tests.py", "--count", str(count)], + cwd=work, capture_output=True, text=True) + path.write_text(original) + n = failures(test.stdout + test.stderr) + if n is None: + sys.exit(f"{name}: the tests gave no failure count\n{(test.stdout + test.stderr)[-2000:]}") + rows.append((name, rel, old, new, equivalent, n)) + print(f"{name}: {n} failures", flush=True) + return rows + + +def write(rows, count): + lines = [ + "# Planted bugs", + "", + "Written by `python3 tests/planted_bugs.py`. Each row is one small change to the", + f"code, made in a copy. The tests ran on {count:,} inputs from their recorded seed", + "against the changed tool. A bug is caught when they report failures.", + "", + "| Bug | File | Failures |", + "|-----|------|----------|", + ] + for name, rel, _, _, equivalent, n in rows: + cell = str(n) if n else ("0, equivalent: " + equivalent if equivalent else "0, NOT CAUGHT") + lines.append(f"| {name} | `{rel}` | {cell} |") + lines += ["", "## The changes", ""] + for name, rel, old, new, _, _ in rows: + lines += [f"**{name}** in `{rel}`:", "", "```", "- " + old.replace("\n", "\n- "), + "+ " + new.replace("\n", "\n+ "), "```", ""] + (ROOT / "tests" / "PLANTED-BUGS.md").write_text("\n".join(lines)) + + +def main(): + ap = argparse.ArgumentParser(description=__doc__.splitlines()[0]) + ap.add_argument("--count", type=int, default=COUNT) + args = ap.parse_args() + rows = run(args.count) + write(rows, args.count) + missed = [r[0] for r in rows if not r[5] and not r[4]] + caught = sum(1 for r in rows if r[5]) + print(f"{caught} of {len(rows)} planted bugs caught; results in tests/PLANTED-BUGS.md") + if missed: + sys.exit("not caught: " + ", ".join(missed)) + + +if __name__ == "__main__": + main() diff --git a/tests/run_tests.py b/tests/run_tests.py new file mode 100644 index 0000000..efa443b --- /dev/null +++ b/tests/run_tests.py @@ -0,0 +1,1587 @@ +#!/usr/bin/env python3 +"""Differential tests: the Lean request head parser against a copy of +the rules written here in Python. + +The oracle is the grammar and the rules of RFC 9112, RFC 9110 and +RFC 3986, written in this script from the RFCs, separately from the Lean +code and the Lean spec: regular expressions for the request line, the +field lines and the request target, then the Host rule of RFC 9112 +section 3.2, the CONNECT rule of RFC 9110 section 9.3.6, the rule of +RFC 9110 sections 4.2.1, 4.2.2 and 4.2.4 for http and https targets, the +rule of RFC 9112 section 3.3 that the host of the target URI built from +a Host value or an authority-form target, for any method, is not empty, +the framing rules of RFC 9112 section 6.3, and the rule of RFC 9110 +section 9.3.6 that a CONNECT has no content, with the choices the Lean +spec makes (see SPEC.md). Transfer-Encoding is read as one list made of all its field +lines (RFC 9110 section 5.2), in which empty elements do not count +(section 5.6.1.2). The IPv6 rule of RFC 3986 is also checked against +Python's `ipaddress`, as a test of the oracle itself. + +Inputs come from a recorded seed: + +- valid heads: methods, targets in all four forms (paths with + percent-escapes and queries, URIs with user info, registered names, + IPv4, IPv6 in all its compressed forms, IPvFuture with `v` or `V`, and + ports, host and port, and `*`), versions, among them major version 9, + fields with values of visible characters, obs-text and inner + whitespace, and Host, Content-Length and Transfer-Encoding fields in + many forms, some valid and some not; +- hosts that RFC 3986 does not allow, in targets and Host values: an + IPv6 literal whose IPv4 tail has an octet above 255 or with a leading + zero, an IP literal with an RFC 6874 zone ID such as + `[fe80::1%25eth0]`, IPvFuture with no hex digit or nothing after the + dot, such as `[v.a]` and `[v1.]`, and an IPv6 address with no + brackets; +- Host values that are empty, and Host values with an empty host before + a colon, such as `:80` and `:`; +- CONNECT, and `connect`, which is another method, with host and port + targets whose port is empty, 0, above 65535, long or with leading + zeros, with an empty host, such as `:443`, and with targets of the + other three forms; CONNECT with Content-Length or Transfer-Encoding; + and authority-form targets with an empty host for other methods; +- http and https targets, with the scheme in any case: with a host + (registered names and IP literals, ports, paths and queries), with an + empty host such as `http:///a`, with no `//` such as `http:/a`, with + userinfo such as `http://u@a/`, and with an empty port; `CONNECT + http:80`, which names the host `http`, and the same target with + another method; and schemes such as `httpx` and `ws`, which the rule + does not cover; +- Transfer-Encoding lists with empty elements, such as `chunked,` and + `, chunked`, and heads with several Transfer-Encoding lines: all but + one empty or only commas, chunked in two of them, or chunked split + over two; +- empty lines before the request line, and octets after the head; +- mutations of valid heads: an octet replaced, deleted or inserted, a + bare CR, a bare LF, a NUL, whitespace before a colon, a folded line, a + line starting with whitespace, a tab or two spaces in the request + line, a line repeated, the head cut short; +- fixed cases: the examples of RFC 9112, the classic shapes of request + smuggling, every input of `Spec.head_vectors` in Spec.lean, the inputs + that the reviews of these tests named, and malformed requests to the + tool; +- long inputs, outside the count: a request line and a field value of + 16 MB, a Content-Length and CONNECT ports of 1,000,000 digits, and + 64 KB of spaces in a Transfer-Encoding list, each with a time bound. + +It builds the executable first, writes tests/TEST-RESULTS.md, and exits +non-zero if any input disagrees. +""" + +import argparse +import ipaddress +import itertools +import platform +import random +import re +import subprocess +import sys +import threading +import time +from pathlib import Path + +ROOT = Path(__file__).resolve().parent.parent +EXE = ROOT / ".lake" / "build" / "bin" / "httphead" +RESULTS = ROOT / "tests" / "TEST-RESULTS.md" +TIMEOUT = 1800 +BUILD_TIMEOUT = 3600 + +# RFC 5234, Appendix B.1 +DIGIT = rb"[0-9]" +HEXDIG = rb"[0-9A-Fa-f]" + +# RFC 3986, Appendix A +UNRESERVED = rb"[A-Za-z0-9\-._~]" +PCT = rb"%[0-9A-Fa-f]{2}" +SUB_DELIMS = rb"[!$&'()*+,;=]" +PCHAR = rb"(?:" + UNRESERVED + rb"|" + PCT + rb"|" + SUB_DELIMS + rb"|[:@])" +SEGMENT = PCHAR + rb"*" +SEGMENT_NZ = PCHAR + rb"+" +QUERY = rb"(?:" + PCHAR + rb"|[/?])*" +SCHEME = rb"[A-Za-z][A-Za-z0-9+\-.]*" +USERINFO = rb"(?:" + UNRESERVED + rb"|" + PCT + rb"|" + SUB_DELIMS + rb"|:)*" +H16 = HEXDIG + rb"{1,4}" +DEC_OCTET = rb"(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])" +IPV4 = DEC_OCTET + rb"\." + DEC_OCTET + rb"\." + DEC_OCTET + rb"\." + DEC_OCTET +LS32 = rb"(?:" + H16 + rb":" + H16 + rb"|" + IPV4 + rb")" +H16C = H16 + rb":" + + +def _upto(n, r): + return rb"(?:" + r + rb"){0," + str(n).encode() + rb"}" + + +def _times(n, r): + return rb"(?:" + r + rb"){" + str(n).encode() + rb"}" + + +IPV6 = rb"(?:" + rb"|".join([ + _times(6, H16C) + LS32, + rb"::" + _times(5, H16C) + LS32, + rb"(?:" + H16 + rb")?::" + _times(4, H16C) + LS32, + rb"(?:" + _upto(1, H16C) + H16 + rb")?::" + _times(3, H16C) + LS32, + rb"(?:" + _upto(2, H16C) + H16 + rb")?::" + _times(2, H16C) + LS32, + rb"(?:" + _upto(3, H16C) + H16 + rb")?::" + H16C + LS32, + rb"(?:" + _upto(4, H16C) + H16 + rb")?::" + LS32, + rb"(?:" + _upto(5, H16C) + H16 + rb")?::" + H16, + rb"(?:" + _upto(6, H16C) + H16 + rb")?::", +]) + rb")" +IPVFUTURE = rb"[vV]" + HEXDIG + rb"+\.(?:" + UNRESERVED + rb"|" + SUB_DELIMS + rb"|:)+" +IP_LITERAL = rb"\[(?:" + IPV6 + rb"|" + IPVFUTURE + rb")\]" +REG_NAME = rb"(?:" + UNRESERVED + rb"|" + PCT + rb"|" + SUB_DELIMS + rb")*" +HOST = rb"(?:" + IP_LITERAL + rb"|" + IPV4 + rb"|" + REG_NAME + rb")" +PORT = DIGIT + rb"*" +AUTHORITY = rb"(?:" + USERINFO + rb"@)?" + HOST + rb"(?::" + PORT + rb")?" +PATH_ABEMPTY = rb"(?:/" + SEGMENT + rb")*" +PATH_ABSOLUTE = rb"/(?:" + SEGMENT_NZ + PATH_ABEMPTY + rb")?" +PATH_ROOTLESS = SEGMENT_NZ + PATH_ABEMPTY +HIER_PART = (rb"(?://" + AUTHORITY + PATH_ABEMPTY + rb"|" + PATH_ABSOLUTE + rb"|" + PATH_ROOTLESS + + rb"|)") +ABSOLUTE_URI = SCHEME + rb":" + HIER_PART + rb"(?:\?" + QUERY + rb")?" + +# RFC 9110, sections 4.1, 5.5, 5.6.2, 7.2 +TCHAR = rb"[!#$%&'*+\-.^_`|~0-9A-Za-z]" +TOKEN = TCHAR + rb"+" +VCHAR_OR_OBS = rb"[\x21-\x7e\x80-\xff]" +FIELD_VALUE = rb"(?:" + VCHAR_OR_OBS + rb"(?:[ \t\x21-\x7e\x80-\xff]*" + VCHAR_OR_OBS + rb")?)?" +ABSOLUTE_PATH = rb"(?:/" + SEGMENT + rb")+" +# Host = uri-host [ ":" port ] +HOST_FIELD = re.compile(rb"(?P" + HOST + rb")(?::" + PORT + rb")?") + +# RFC 9112, sections 3.2.1 to 3.2.4 +ORIGIN_FORM = ABSOLUTE_PATH + rb"(?:\?" + QUERY + rb")?" +AUTHORITY_FORM = HOST + rb":" + PORT +REQUEST_TARGET = rb"(?:" + ORIGIN_FORM + rb"|" + ABSOLUTE_URI + rb"|" + AUTHORITY_FORM + rb"|\*)" + +# RFC 9112, sections 3 and 5: the request line and a field line. +REQUEST_LINE = re.compile(rb"(" + TOKEN + rb") (" + REQUEST_TARGET + rb") HTTP/([0-9])\.([0-9])") +FIELD_LINE = re.compile(rb"(" + TOKEN + rb"):[ \t]*(" + FIELD_VALUE + rb")[ \t]*") +IPV6_RE = re.compile(IPV6) +TARGET_RE = re.compile(REQUEST_TARGET) + +# RFC 9110, section 5.6.1.2: a recipient reads a list `#element` as +# [ element ] *( OWS "," OWS [ element ] ), and "Empty elements do not +# contribute to the count of elements present". So a list of the one +# coding chunked has chunked once, and any number of empty elements +# before and after it. Coding names are case-insensitive (RFC 9112, +# section 7). +OWS = rb"[ \t]*" +EMPTY_ELEMENTS = rb"(?:" + OWS + rb"," + OWS + rb")*" +CHUNKED_ALONE = re.compile(EMPTY_ELEMENTS + rb"[Cc][Hh][Uu][Nn][Kk][Ee][Dd]" + EMPTY_ELEMENTS) + +# RFC 9110, section 9.3.6: the target of CONNECT is the host and the port +# of the tunnel, "separated by a colon": `uri-host ":" port`. +CONNECT_TARGET = re.compile(rb"(?P" + HOST + rb"):(?P" + PORT + rb")") + +# RFC 9110, sections 4.2.1 and 4.2.2: +# http-URI = "http" "://" authority path-abempty [ "?" query ] +# https-URI = "https" "://" authority path-abempty [ "?" query ] +# An authority with no userinfo is host [ ":" port ] (RFC 3986, section +# 3.2), and after it come path-abempty and the query. +HOST_PORT = re.compile(rb"(" + HOST + rb")(?::" + PORT + rb")?") +PATH_QUERY = re.compile(PATH_ABEMPTY + rb"(?:\?" + QUERY + rb")?") + + +def reference(bs): + """(method, target, major, minor, fields, rest) for the head at the + start of `bs`, or None when there is none.""" + i = 0 + while bs[i:i + 2] == b"\r\n": + i += 2 + # The head ends at the first empty line; no line in it may hold a CR + # or LF of its own. + end = bs.find(b"\r\n\r\n", i) + if end < 0: + return None + lines = bs[i:end].split(b"\r\n") + if any(b"\r" in l or b"\n" in l for l in lines): + return None + m = REQUEST_LINE.fullmatch(lines[0]) + if not m: + return None + fields = [] + for line in lines[1:]: + f = FIELD_LINE.fullmatch(line) + if not f: + return None + fields.append((f.group(1), f.group(2))) + return m.group(1), m.group(2), int(m.group(3)), int(m.group(4)), fields, bs[end + 4:] + + +def target_uri_host_ok(host): + """RFC 9112, section 3.3: for a target that is not in absolute-form, + the target URI is "the scheme, "://", authority, and combined path + and query component", and its authority is the CONNECT target, or + else the Host value. The scheme here is http or https, so by RFC 9110 + sections 4.2.1 and 4.2.2 the host in that authority must not be + empty: "A recipient that processes such a URI reference MUST reject + it as invalid".""" + return host != b"" + + +def host_ok(value): + """The Host rule of RFC 9112, section 3.2, for one Host value: it is + `uri-host [ ":" port ]` (RFC 9110, section 7.2), with a host that is + not empty, as target_uri_host_ok says. An empty value is allowed: + section 3.2 has a client send one when the target URI has no + authority, and section 3.3 says that then "the server can reject the + request or determine whether a configured default applies".""" + if value == b"": + return True + m = HOST_FIELD.fullmatch(value) + return m is not None and target_uri_host_ok(m.group("host")) + + +def connect_ok(method, target): + """RFC 9110, section 9.3.6: "A server MUST reject a CONNECT request + that targets an empty or invalid port number". The method token is + case-sensitive (section 9.1), so only `CONNECT` is held to this. Its + target must be a host and a port, the host must not be empty (see + target_uri_host_ok), and here a valid port is from 1 to 65535.""" + if method != b"CONNECT": + return True + m = CONNECT_TARGET.fullmatch(target) + if not m or not target_uri_host_ok(m.group("host")): + return False + # Leading zeros do not change the number. More than five digits after + # them is above 65535, and int() is not given very long strings. + digits = m.group("port").lstrip(b"0") + return 1 <= len(digits) <= 5 and int(digits) <= 65535 + + +def http_scheme(target): + """Whether the scheme of `target` is http or https. Schemes are + case-insensitive (RFC 3986, section 3.1), and a scheme ends at the + first colon.""" + scheme, colon, _ = target.partition(b":") + return bool(colon) and scheme.lower() in (b"http", b"https") + + +def http_problem(target): + """Why a target whose scheme is http or https is not allowed, or None. + RFC 9110, sections 4.2.1 and 4.2.2: such a URI is `scheme "://" + authority path-abempty [ "?" query ]`, and "A recipient that + processes such a URI reference MUST reject it as invalid" when its + host is empty. Section 4.2.4: "a recipient SHOULD parse for userinfo + and treat its presence as an error".""" + rest = target.partition(b":")[2] + if not rest.startswith(b"//"): + return "no authority" + # RFC 3986, section 3.2: the authority "is terminated by the next + # slash ("/"), question mark ("?"), or number sign ("#") character, + # or by the end of the URI". Section 3.2.1: userinfo is followed by + # "@", which no host holds. + end = 2 + while end < len(rest) and rest[end] not in b"/?#": + end += 1 + authority, tail = rest[2:end], rest[end:] + if b"@" in authority: + return "userinfo" + hp = HOST_PORT.fullmatch(authority) + if hp and hp.group(1) == b"": + return "empty host" + if not hp or not PATH_QUERY.fullmatch(tail): + return "other" + return None + + +def http_target_ok(method, target): + """The rule of RFC 9110, sections 4.2.1, 4.2.2 and 4.2.4, for a target + whose scheme is http or https. The target of CONNECT is a host and a + port (section 9.3.6), in authority-form, which has no scheme, so the + rule is not for it, and `CONNECT http:80` names the host `http`. Any + other method, `connect` too, is held to it.""" + return method == b"CONNECT" or not http_scheme(target) or http_problem(target) is None + + +def combined(values): + """The combined field value of field lines with these values (RFC + 9110, section 5.2): the values in order, with a comma between each.""" + return b",".join(values) + + +def framing(head): + """How this library frames the body after the head, or None when this + library refuses it: RFC 9112 sections 3.2 and 6.3 and RFC 9110 + sections 4.2.1, 4.2.2, 4.2.4 and 9.3.6, with the choices of SPEC.md.""" + method, target, major, minor, fields, _ = head + if major != 1: + return None + + def named(n): + return [v for k, v in fields if k.lower() == n] + + hosts = named(b"host") + if len(hosts) > 1 or (minor >= 1 and len(hosts) != 1): + return None + if any(not host_ok(v) for v in hosts): + return None + if not connect_ok(method, target): + return None + if not http_target_ok(method, target): + return None + # RFC 9112, section 3.3: an authority-form target is the authority of + # the target URI for any method, and RFC 9110, section 4.2.1, says an + # empty host is invalid. Such a target starts with ":". + if target.startswith(b":"): + return None + te, cl = named(b"transfer-encoding"), named(b"content-length") + if te and cl: + return None + if te: + if minor < 1 or not CHUNKED_ALONE.fullmatch(combined(te)): + return None + fr = "chunked" + elif cl: + if len(cl) != 1 or not re.fullmatch(rb"[0-9]+", cl[0]): + return None + # The number the digits write, in decimal: the digits without + # their leading zeros. int() is not given very long strings. + fr = f"length {cl[0].lstrip(b'0').decode() or '0'}" + else: + fr = "length 0" + # RFC 9110, section 9.3.6: "A CONNECT request message does not have + # content." Refused here when it would have some. + if method == b"CONNECT" and fr != "length 0": + return None + return fr + + +def printed(head): + method, target, major, minor, fields, _ = head + out = method + b" " + target + b" HTTP/" + str(major).encode() + b"." + str(minor).encode() + b"\r\n" + for k, v in fields: + out += k + b": " + v + b"\r\n" + return out + b"\r\n" + + +def answer(bs, head=None): + """The answer `httphead serve` must give to `head` and the hex of + `bs`. `head` is reference(bs), given when it is already known.""" + head = head or reference(bs) + if head is None: + return "REJECT" + fr = framing(head) + return f"OK\t{printed(head).hex()}\t{head[5].hex()}\t{fr or 'reject'}" + + +# Generators + +# CONNECT has its own targets, in valid_head(). +METHODS = [b"GET", b"POST", b"PUT", b"DELETE", b"HEAD", b"OPTIONS", b"PATCH", b"TRACE"] +TCHARS = b"!#$%&'*+-.^_`|~0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" +UNRES = b"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-._~" +SUBS = b"!$&'()*+,;=" + + +def pick(rng, s): + return bytes([rng.choice(s)]) + + +def token(rng, n=None): + return b"".join(pick(rng, TCHARS) for _ in range(n or rng.randint(1, 8))) + + +def pct(rng): + hexd = b"0123456789ABCDEFabcdef" + return b"%" + pick(rng, hexd) + pick(rng, hexd) + + +def pchars(rng, n, extra=b":@"): + out = b"" + for _ in range(n): + r = rng.random() + if r < 0.7: + out += pick(rng, UNRES) + elif r < 0.8: + out += pct(rng) + elif r < 0.92: + out += pick(rng, SUBS) + else: + out += pick(rng, extra or UNRES) + return out + + +def path(rng): + return b"".join(b"/" + pchars(rng, rng.randint(0, 6)) for _ in range(rng.randint(1, 4))) + + +def query(rng): + return pchars(rng, rng.randint(0, 8), b":@/?") + + +# Octets that are not a dec-octet (RFC 3986, section 3.2.2): above 255, +# or with a leading zero. +BAD_OCTETS = [b"256", b"259", b"260", b"299", b"300", b"999", b"1000", b"00", b"01", b"099", b"000", + b"0255"] + + +def ipv4(rng, bad=False): + """A dotted quad of dec-octets, or with `bad`, with one octet that is + not a dec-octet.""" + def octet(): + return str(rng.choice([0, 1, 9, 10, 99, 100, 199, 200, 249, 250, 255, rng.randint(0, 255)])).encode() + octets = [octet() for _ in range(4)] + if bad: + octets[rng.randrange(4)] = rng.choice(BAD_OCTETS) + return b".".join(octets) + + +def h16(rng): + return b"".join(pick(rng, b"0123456789abcdefABCDEF") for _ in range(rng.randint(1, 4))) + + +def ipv6(rng): + """An IPv6 address, plain or compressed with "::", sometimes with an + IPv4 tail, and sometimes with one group too many for "::". About a + third of the IPv4 tails have an octet that is not a dec-octet.""" + v4 = rng.random() < 0.2 + width = 6 if v4 else 8 + if rng.random() < 0.3: + s = b":".join(h16(rng) for _ in range(width)) + if v4: + s += b":" + else: + k = rng.randint(0, width) + a = rng.randint(0, k) + s = b":".join(h16(rng) for _ in range(a)) + b"::" + b":".join(h16(rng) for _ in range(k - a)) + if v4 and not s.endswith(b":"): + s += b":" + return s + ipv4(rng, rng.random() < 0.35) if v4 else s + + +def zone(rng): + """An RFC 6874 zone ID, which RFC 3986 does not allow, after "%25" or + a bare "%".""" + zid = rng.choice([b"eth0", b"1", b"lo", b"en%30", b"x~y", pchars(rng, rng.randint(1, 4), b"")]) + return rng.choice([b"%25", b"%25", b"%"]) + zid + + +def host(rng): + """A host: a registered name, IPv4, an IP literal, or an empty name. + Some are not a host of RFC 3986: an IP literal with a zone ID, an + IPv6 address with no brackets, and the bad IPv4 tails of ipv6().""" + r = rng.random() + if r < 0.48: + return b".".join(pchars(rng, rng.randint(1, 8), b"") for _ in range(rng.randint(1, 3))) + if r < 0.66: + return ipv4(rng) + if r < 0.86: + return b"[" + ipv6(rng) + b"]" + if r < 0.89: + return b"[" + ipv6(rng) + zone(rng) + b"]" + if r < 0.92: + return ipv6(rng) + if r < 0.97: + # IPvFuture, "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" ), + # and sometimes with no hex digit or no octet after the dot, which + # it does not allow. + tail = b"".join(pick(rng, UNRES + SUBS + b":") for _ in range(rng.randint(1, 5))) + v = rng.choice([b"v", b"V"]) + hexd = h16(rng) + x = rng.random() + if x < 0.1: + hexd = b"" + elif x < 0.2: + tail = b"" + elif x < 0.36: + tail = pchars(rng, 3) + return b"[" + v + hexd + b"." + tail + b"]" + return b"" + + +def port(rng): + return str(rng.choice([80, 443, 8080, 0, 65535, rng.randint(0, 99999)])).encode() if rng.random() < 0.9 else b"" + + +# Ports for CONNECT: empty, 0, the limits of 1 to 65535, leading zeros, +# and numbers that wrap to 80 in 16, 32 or 64 bits. +CONNECT_PORTS = [b"", b"0", b"00", b"1", b"80", b"080", b"443", b"65535", b"065535", b"65536", b"99999", + b"65616", b"4294967376", b"18446744073709551696", b"000000000000000000000443"] + + +def connect_port(rng): + r = rng.random() + if r < 0.5: + return rng.choice(CONNECT_PORTS) + if r < 0.8: + return str(rng.randint(0, 70000)).encode() + if r < 0.92: + return b"0" * rng.randint(1, 30) + str(rng.randint(0, 66000)).encode() + return b"".join(pick(rng, b"0123456789") for _ in range(rng.randint(6, 40))) + + +def connect_target(rng): + """A target for CONNECT: mostly a host and a port, sometimes with an + empty host or with the host `http` or `https`, and sometimes another + form, such as a URI that also fits authority-form.""" + r = rng.random() + if r < 0.65: + return host(rng) + b":" + connect_port(rng) + if r < 0.7: + return b":" + connect_port(rng) + if r < 0.77: + return scheme_case(rng, rng.choice([b"http", b"https"])) + b":" + connect_port(rng) + if r < 0.87: + return rng.choice([b"a:1", b"x:443", b"a:0", b"a:65536", b"a:", b"http://a:80/", b"http://a:80", + b"a:b", b"a:1/", b"a:/", b"a:1?q", b"fe80::1:80", b"mailto:x@y", b"*", b"/", + b"http:80", b"https:443", b"HTTP:443", b"http:", b"https:0", b"http:/a"]) + return target(rng) + + +def scheme_case(rng, s): + """`s` in lower case, upper case, with a capital, or in mixed case. + Schemes are case-insensitive (RFC 3986, section 3.1).""" + r = rng.random() + if r < 0.5: + return s + if r < 0.7: + return s.upper() + if r < 0.85: + return s[:1].upper() + s[1:] + return bytes(c ^ 0x20 if rng.random() < 0.5 else c for c in s) + + +# Ends of http and https targets, after the colon, that are easy to get +# wrong: an empty port, "@" after the authority, userinfo that looks +# like a port, an empty host before ":" or "?", and a path that starts +# with "//". +HTTP_TRICKY = [b"//a:/", b"//a:", b"//a?", b"//a?@", b"//a/u@b", b"//a/?u@b", b"//a:1@b/", b"//a:b@c/", + b"//@a", b"//u@", b"//u@:80", b"////a", b"//[::1]", b"//[::1]:/", b"//1.2.3.4:080", + b"//%41/", b"//!$&'()*+,;=/", b"//a.b.c:65536/x?y", b"//:", b"//:/", b"//?", b"//?q", + b"//a//", b"80", b"443", b"//80", b"/a:b@c"] + + +def http_target(rng): + """A target with the scheme http or https, in any case: mostly an + http-URI or https-URI with a host, and sometimes one with an empty + host, with userinfo, or with no "//" at all.""" + scheme = scheme_case(rng, rng.choice([b"http", b"https"])) + + def opt_port(): + return b":" + port(rng) if rng.random() < 0.35 else b"" + r = rng.random() + if r < 0.64: + rest = b"//" + host(rng) + opt_port() + elif r < 0.72: + # An empty host + rest = b"//" + opt_port() + elif r < 0.82: + # Userinfo, sometimes empty + user = rng.choice([b"", b"u", b"u:p", b":", b"u:", pchars(rng, rng.randint(0, 5), b":")]) + rest = b"//" + user + b"@" + host(rng) + opt_port() + elif r < 0.94: + # No "//": an empty hier-part, path-absolute, path-rootless, or + # digits, which also fit authority-form + rest = rng.choice([b"", b"/", b"/" + pchars(rng, rng.randint(1, 5)), + pchars(rng, rng.randint(1, 5)), port(rng) or b"80"]) + if rest and rng.random() < 0.3: + rest += path(rng) + return scheme + b":" + rest + (b"?" + query(rng) if rng.random() < 0.2 else b"") + else: + return scheme + b":" + rng.choice(HTTP_TRICKY) + if rng.random() < 0.6: + rest += path(rng) + if rng.random() < 0.3: + rest += b"?" + query(rng) + return scheme + b":" + rest + + +def target(rng): + r = rng.random() + if r < 0.55: + return path(rng) + (b"?" + query(rng) if rng.random() < 0.4 else b"") + if r < 0.8: + if rng.random() < 0.45: + return http_target(rng) + # Other schemes, some of which start with http, are not held to + # the rule for http and https. + scheme = rng.choice([b"ws", b"WS", b"a+b.c-d", b"x", b"httpx", b"HTTPX", b"https+x", b"http.s", + b"htt"]) + auth = b"" + if rng.random() < 0.15: + auth += pchars(rng, rng.randint(0, 5), b":") + b"@" + auth += host(rng) + if rng.random() < 0.5: + auth += b":" + port(rng) + hp = rng.choice([b"//" + auth + (path(rng) if rng.random() < 0.6 else b""), + path(rng), pchars(rng, rng.randint(1, 5)), b""]) + return scheme + b":" + hp + (b"?" + query(rng) if rng.random() < 0.3 else b"") + if r < 0.95: + return host(rng) + b":" + port(rng) + return b"*" + + +def value(rng): + r = rng.random() + if r < 0.1: + return b"" + out = b"" + for _ in range(rng.randint(1, 20)): + x = rng.random() + if x < 0.8: + out += bytes([rng.randint(0x21, 0x7E)]) + elif x < 0.9: + out += bytes([rng.randint(0x80, 0xFF)]) + else: + out += rng.choice([b" ", b"\t"]) + return out + + +def ows(rng): + return rng.choice([b"", b" ", b" ", b"\t", b" ", b" \t "]) + + +def host_value(rng): + """A Host value: mostly a host with an optional port, sometimes empty + or with an empty host before a colon, and sometimes not of the + grammar.""" + r = rng.random() + if r < 0.9: + h = host(rng) + return h + (b":" + port(rng) if rng.random() < 0.3 else b"") + if r < 0.95: + return rng.choice([b"", b"", b":", b":80", b":" + port(rng)]) + return rng.choice([b"a b", b"x/y", b"[::1", b"h:p", b"@x", b"%zz", b"x?", b"::1", b"fe80::1", + b"::ffff:1.2.3.4"]) + + +CL_VALUES = [b"0", b"5", b"007", b"18446744073709551616", b"+5", b"-1", b"5, 5", b"5,5", b"0x5", + b"5 5", b" ", b"", b"1e3"] +TE_VALUES = [b"chunked", b"Chunked", b"CHUNKED", b"gzip, chunked", b"chunked, identity", b"xchunked", + b"chunked;q=1", b"identity", b"chunked,", b",chunked", b"chunk", b"chunked chunked"] +# Lists with empty elements (RFC 9110, section 5.6.1.2), some of the one +# coding chunked and some not. +TE_LISTS = [b"chunked,", b", chunked", b",chunked,", b"chunked , ,", b"chunked\t,", b",", b", ,", + b"chunked,,chunked", b"chunked, chunked", b"CHUNKED ,", b", ,chunked, ,", b",,", b"gzip,", + b", gzip, chunked", b"chunked, ,identity", b"cHuNkEd\t,\t,"] +# Values with no element: empty, or only commas and whitespace. +NO_ELEMENT = [b"", b"", b",", b", ,", b" , ", b",,", b"\t,"] + + +def te_list(rng): + """A list with chunked in any case and empty elements around it, and + sometimes chunked twice or another coding before it.""" + name = bytes(c ^ 0x20 if rng.random() < 0.25 else c for c in b"chunked") + + def commas(): + return b"".join(ows(rng) + b"," + ows(rng) for _ in range(rng.choice([0, 0, 1, 1, 2, 3]))) + v = commas() + name + commas() + r = rng.random() + if r < 0.12: + v += b"," + ows(rng) + b"chunked" + elif r < 0.2: + v = rng.choice([b"gzip", b"identity", b"x"]) + ows(rng) + b"," + ows(rng) + v + return v + + +def te_lines(rng): + """The values of the Transfer-Encoding lines of a head: one or more.""" + r = rng.random() + if r < 0.3: + return [rng.choice(TE_VALUES) if rng.random() < 0.5 else rng.choice(TE_VALUES[:3])] + if r < 0.5: + return [te_list(rng)] + if r < 0.6: + return [rng.choice(TE_LISTS)] + if r < 0.78: + # All lines but one empty or only commas. + lines = [rng.choice(NO_ELEMENT) for _ in range(rng.randint(1, 3))] + lines.insert(rng.randint(0, len(lines)), rng.choice(TE_VALUES[:3] + [te_list(rng)])) + return lines + if r < 0.86: + # Two lines that both list chunked. + return [rng.choice(TE_VALUES[:3] + [b"chunked,"]), rng.choice(TE_VALUES[:3] + [b", chunked"])] + if r < 0.9: + # chunked split over two lines. + k = rng.randint(1, 6) + return [b"chunked"[:k], b"chunked"[k:]] + if r < 0.94: + return [rng.choice(NO_ELEMENT) for _ in range(rng.randint(1, 3))] + return [rng.choice(TE_VALUES), rng.choice(TE_VALUES)] + + +NAMES_CASED = {b"host": [b"Host", b"host", b"HOST", b"hOsT"], + b"content-length": [b"Content-Length", b"content-length", b"CONTENT-LENGTH"], + b"transfer-encoding": [b"Transfer-Encoding", b"transfer-encoding", b"TRANSFER-ENCODING"]} + + +def valid_head(rng): + """A head that fits the grammar, which the framing may still reject.""" + r = rng.random() + if r < 0.07: + method, tgt = b"CONNECT", connect_target(rng) + elif r < 0.085: + # Another method: the method token is case-sensitive. + method, tgt = rng.choice([b"connect", b"connect", b"Connect"]), connect_target(rng) + else: + method = rng.choice(METHODS) if rng.random() < 0.8 else token(rng) + tgt = target(rng) + major, minor = rng.choice([(1, 1)] * 14 + [(1, 0)] * 4 + [(1, 2), (2, 0), (0, 9), (1, 9), (9, 9), + (9, 1)]) + line = method + b" " + tgt + b" HTTP/" + str(major).encode() + b"." + str(minor).encode() + fields = [] + nhost = rng.choice([1] * 16 + [0, 2]) + for _ in range(nhost): + fields.append((rng.choice(NAMES_CASED[b"host"]), host_value(rng))) + x = rng.random() + if x < 0.3: + for _ in range(rng.choice([1] * 6 + [2])): + fields.append((rng.choice(NAMES_CASED[b"content-length"]), + rng.choice(CL_VALUES) if rng.random() < 0.25 else str(rng.randint(0, 10 ** 6)).encode())) + elif x < 0.5: + for v in te_lines(rng): + fields.append((rng.choice(NAMES_CASED[b"transfer-encoding"]), v)) + elif x < 0.55: + fields.append((rng.choice(NAMES_CASED[b"transfer-encoding"]), rng.choice(TE_VALUES))) + fields.append((rng.choice(NAMES_CASED[b"content-length"]), rng.choice(CL_VALUES))) + for _ in range(rng.randint(0, 5)): + fields.append((token(rng), value(rng))) + rng.shuffle(fields) + out = b"\r\n" * rng.choice([0] * 9 + [1, 2]) + out += line + b"\r\n" + for k, v in fields: + out += k + b":" + ows(rng) + v + ows(rng) + b"\r\n" + out += b"\r\n" + if rng.random() < 0.3: + out += rng.choice([b"hello", b"0\r\n\r\n", b"GET / HTTP/1.1\r\n\r\n", bytes([rng.randint(0, 255)])]) + return out + + +def mutate(rng, bs): + """One change of a kind that request smuggling and loose parsers turn + on.""" + kind = rng.randrange(13) + i = rng.randrange(len(bs) + 1) + if kind == 0: + return bs[:i] + bytes([rng.randrange(256)]) + bs[i + 1:] + if kind == 1: + return bs[:i] + bs[i + 1:] + if kind == 2: + return bs[:i] + bytes([rng.randrange(256)]) + bs[i:] + if kind == 3: + return bs[:i] + b"\r" + bs[i:] + if kind == 4: + return bs[:i] + b"\n" + bs[i:] + if kind == 5: + return bs[:i] + b"\x00" + bs[i:] + if kind == 6: + j = bs.find(b":") + return bs[:j] + rng.choice([b" ", b"\t"]) + bs[j:] if j > 0 else bs + b" " + if kind == 7: + j = bs.find(b"\r\n") + k = bs.find(b"\r\n", j + 2) + return bs[:k] + b"\r\n" + rng.choice([b" ", b"\t"]) + b"folded" + bs[k:] if k > 0 else bs + if kind == 8: + j = bs.find(b"\r\n") + return bs[:j + 2] + rng.choice([b" ", b"\t"]) + bs[j + 2:] if j >= 0 else bs + if kind == 9: + j = bs.find(b" ") + return bs[:j] + rng.choice([b"\t", b" ", b"\x0b", b"\x0c"]) + bs[j + 1:] if j >= 0 else bs + if kind == 10: + lines = bs.split(b"\r\n") + if len(lines) > 2: + k = rng.randrange(1, len(lines) - 1) + lines.insert(k, lines[k]) + return b"\r\n".join(lines) + if kind == 11: + return bs[:i] + return bs.replace(b"\r\n", b"\n", 1) if rng.random() < 0.5 else bs.replace(b"\r\n", b"\r", 1) + + +FIXED = [ + # RFC 9112, sections 3.2.1 to 3.2.4, and RFC 9110, section 7.2 + b"GET /where?q=now HTTP/1.1\r\nHost: www.example.org\r\n\r\n", + b"GET http://www.example.org/pub/WWW/TheProject.html HTTP/1.1\r\nHost: www.example.org\r\n\r\n", + b"CONNECT www.example.com:80 HTTP/1.1\r\nHost: www.example.com\r\n\r\n", + b"OPTIONS * HTTP/1.1\r\nHost: www.example.org:8001\r\n\r\n", + b"OPTIONS http://www.example.org:8001 HTTP/1.1\r\nHost: www.example.org:8001\r\n\r\n", + b"GET /pub/WWW/ HTTP/1.1\r\nHost: www.example.org\r\n\r\n", + # Spec.head_vectors: a body, and chunked in any case, after a tab or + # two spaces, and with a parameter + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\n\r\nhello", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: Chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\tchunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked;a=b\r\n\r\n", + # RFC 9112, section 6.1 + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: gzip, chunked\r\n\r\n", + # RFC 9110, section 5.6.1.2: lists with empty elements, one line or + # several (section 5.2) + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: , chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding:\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: ,\r\nTransfer-Encoding: Chunked\r\n" + b"Transfer-Encoding: , ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: ,chunked,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked , ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\t,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: CHUNKED ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: , ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\r\nTransfer-Encoding: ,\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,,chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chun\r\nTransfer-Encoding: ked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: gzip\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked,\r\nContent-Length: 0\r\n\r\n", + b"POST /a HTTP/1.0\r\nTransfer-Encoding: chunked,\r\n\r\n", + # Smuggling shapes + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 6\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 6\r\n\r\nhello", + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nContent-Length: 5\r\n\r\nhello", + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5, 5\r\n\r\nhello", + b"POST /a HTTP/1.1\r\nHost: x\r\nContent-Length: 5\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nContent-Length: 5\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: xchunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding:\tchunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, identity\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked, chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding: x\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding : chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nX: y\r\n Transfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\n Host: x\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\rTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.1\r\nHost: x\r\nTransfer-Encoding: chunked\x00\r\n\r\n", + b"POST /a HTTP/1.0\r\nTransfer-Encoding: chunked\r\n\r\n", + b"POST /a HTTP/1.0\r\nContent-Length: 3\r\n\r\nabc", + b"GET /a HTTP/1.1\r\nHost: x\r\nContent-Length: +5\r\n\r\n", + b"GET\t/a HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /a HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /a HTTP/1.1 \r\nHost: x\r\n\r\n", + b"GET /a\x0bHTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /a#frag HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /a b HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /%zz HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /%4g HTTP/1.1\r\nHost: x\r\n\r\n", + b"G\"ET /a HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET /a HTTP/1.1\r\nHost: x\r\nX\"Y: z\r\n\r\n", + b"GET http://[::1]:80/ HTTP/1.1\r\nHost: [::1]:80\r\n\r\n", + b"GET http://[::ffff:192.0.2.1]/ HTTP/1.1\r\nHost: [::ffff:192.0.2.1]\r\n\r\n", + b"GET http://[1::2::3]/ HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET http://[vF.a:b]/ HTTP/1.1\r\nHost: x\r\n\r\n", + # IP literals: IPvFuture with an upper-case V, IPv4 tails that are not + # four dec-octets, an RFC 6874 zone ID, and IPv6 with no brackets + b"GET http://[V1.a]/ HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [VF.a]\r\n\r\n", + # IPvFuture with no hex digit, or with nothing after the dot + b"GET / HTTP/1.1\r\nHost: [v.a]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [v1.]\r\n\r\n", + b"GET http://[v1.]/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.255]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.256]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.259]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.260]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.300]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.1000]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::01.2.3.4]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.3.00]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [::1.2.099.4]\r\n\r\n", + b"GET http://[::ffff:1.2.3.256]/ HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET http://[fe80::1%25eth0]/ HTTP/1.1\r\nHost: x\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: [fe80::1%25eth0]\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: ::1\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: fe80::1\r\n\r\n", + b"GET http://::1/ HTTP/1.1\r\nHost: x\r\n\r\n", + # The Host rule + b"GET / HTTP/1.1\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: a\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.1\r\nHost:\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: a b\r\n\r\n", + # An empty host before a colon: the target URI of RFC 9112 section 3.3 + # would have an empty host. The first two are in Spec.head_vectors. + b"GET / HTTP/1.1\r\nHost: :80\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: :\r\n\r\n", + b"OPTIONS * HTTP/1.1\r\nHost: :8080\r\n\r\n", + b"GET http://a/ HTTP/1.1\r\nHost: :80\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: a:\r\n\r\n", + b"GET / HTTP/1.0\r\nHost:\r\n\r\n", + b"GET / HTTP/1.0\r\n\r\n", + b"GET / HTTP/1.0\r\nHost: a\r\nHost: b\r\n\r\n", + # RFC 9110, section 9.3.6: CONNECT, with the port from 1 to 65535 + b"CONNECT a: HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:0 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:00 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:65536 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:99999 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:65616 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:4294967376 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:18446744073709551696 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT / HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT * HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT http://a:80/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT fe80::1:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT ::1:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT [fe80::1%25eth0]:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT [::1]:65535 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:1 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:00080 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT a:065535 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT 1.2.3.4:443 HTTP/1.0\r\n\r\n", + # An empty host. The first is in Spec.head_vectors. + b"CONNECT :80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT :443 HTTP/1.0\r\n\r\n", + b"CONNECT : HTTP/1.1\r\nHost: a\r\n\r\n", + b"connect :80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"connect a: HTTP/1.1\r\nHost: a\r\n\r\n", + b"Connect / HTTP/1.1\r\nHost: a\r\n\r\n", + # An authority-form target with an empty host, for any method (RFC + # 9112, section 3.3). The first two are in Spec.head_vectors. + b"GET :80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"OPTIONS : HTTP/1.1\r\nHost: a\r\n\r\n", + b"OPTIONS :443 HTTP/1.1\r\nHost: a\r\n\r\n", + b"POST :80 HTTP/1.1\r\nHost: a\r\nContent-Length: 1\r\n\r\nx", + b"GET :80 HTTP/1.0\r\n\r\n", + b"GET a:80 HTTP/1.1\r\nHost: a\r\n\r\n", + # A CONNECT has no content (RFC 9110, section 9.3.6). The first three + # are in Spec.head_vectors. + b"CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 5\r\n\r\nhello", + b"CONNECT a:443 HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked\r\n\r\n", + b"CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 0\r\n\r\n", + b"CONNECT a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 000\r\n\r\n", + b"CONNECT a:443 HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: ,\r\n\r\n", + b"connect a:443 HTTP/1.1\r\nHost: a\r\nContent-Length: 5\r\n\r\nhello", + # RFC 9110, sections 4.2.1, 4.2.2 and 4.2.4: http and https targets, + # with the scheme in any case (RFC 3986, section 3.1). First the + # inputs of Spec.head_vectors. + b"GET http: HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:///a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET https://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET HTTP://a:/x HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT http:80 HTTP/1.1\r\nHost: http\r\n\r\n", + # An empty host + b"GET http:// HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET https:// HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://:80/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET HTTP://:/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://?q HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET Https:///a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:////a HTTP/1.1\r\nHost: a\r\n\r\n", + # No "//", so no authority + b"GET https: HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:/a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET HTTP:/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:?q HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:/a:b@c HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET https:443 HTTP/1.1\r\nHost: a\r\n\r\n", + b"OPTIONS http:80 HTTP/1.1\r\nHost: a\r\n\r\n", + # Userinfo + b"GET http://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://u:p@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET HTTPS://u@a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a:1@b/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://u@/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://u@[::1]:80/ HTTP/1.1\r\nHost: a\r\n\r\n", + # Accepted: an empty port or none, IP literals, registered names, + # paths and queries, "@" in the path or the query, and a port above + # 65535, which these rules do not limit + b"GET http://a:/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a: HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET HTTPS://a:443 HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET hTtP://[::1]:8080/x?y HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET https://[v1.x]/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://192.0.2.1/a/b?c=d HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://1.2.3.256/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://%41%42/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a/u@b HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a?u@b HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a//b HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http://a:99999/ HTTP/1.1\r\nHost: a\r\n\r\n", + # CONNECT: a host and a port, so the host is http or https + b"CONNECT http:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT https:443 HTTP/1.1\r\nHost: https\r\n\r\n", + b"CONNECT HTTP:8080 HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT http: HTTP/1.1\r\nHost: a\r\n\r\n", + b"CONNECT http://a:80 HTTP/1.1\r\nHost: a\r\n\r\n", + b"connect http:80 HTTP/1.1\r\nHost: a\r\n\r\n", + # Other schemes are not held to the rule + b"GET httpx:// HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET httpx://u@/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET ws:// HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET ws://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET https+x: HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET htt:a HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET http.s:/ HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET /http://u@a/ HTTP/1.1\r\nHost: a\r\n\r\n", + # Versions + b"GET / HTTP/2.0\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.2\r\nHost: a\r\n\r\n", + b"GET / http/1.1\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.10\r\nHost: a\r\n\r\n", + b"GET / HTTP/1\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.x\r\nHost: a\r\n\r\n", + b"GET / HTTP/9.9\r\nHost: a\r\n\r\n", + b"GET / HTTP/9.1\r\nHost: a\r\n\r\n", + # Empty lines first, and a head cut short + b"\r\n\r\nGET / HTTP/1.1\r\nHost: a\r\n\r\n", + b"\n\r\nGET / HTTP/1.1\r\nHost: a\r\n\r\n", + b"GET / HTTP/1.1\r\nHost: a\r\n", + b"", + b"\r\n", +] + +MALFORMED = [ + ("frob 30", "unknown operation"), + ("HEAD 30", "operations are lower case"), + ("head", "no argument"), + ("head 3", "an odd number of hex digits"), + ("head 3G", "not a hex digit"), + ("head 3A", "hex digits are lower case"), + ("head 30 30", "two arguments"), + (" head 30", "a leading space"), + ("head 30", "two spaces"), +] + + +def cases(seed, count): + """(label, request, expected answer, mutated) for each input.""" + rng = random.Random(seed) + fixed = [("error", req, "error", False) for req, _ in MALFORMED] + fixed += [("fixed", f"head {bs.hex()}", answer(bs), False) for bs in FIXED] + made = 0 + for item in fixed[:count]: + yield item + made += 1 + while made < count: + bs = valid_head(rng) + mutated = rng.random() < 0.35 + if mutated: + new = mutate(rng, bs) + if new == bs: + continue + bs = new + yield ("mutated" if mutated else "valid", f"head {bs.hex()}", answer(bs), mutated) + made += 1 + + +def check_ipv6_oracle(seed, n=20000): + """The RFC 3986 IPv6 rule as written here against `ipaddress`, on + generated addresses and on mutations of them. Returns the count, the + number with an IPv4 tail that is not four dec-octets, and the + disagreements.""" + rng = random.Random(seed + 1) + bad = [] + bad_tails = 0 + for _ in range(n): + a = ipv6(rng) + if rng.random() < 0.4: + a = mutate_text(rng, a) + tail = re.search(rb"[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$", a) + bad_tails += tail is not None and not re.fullmatch(IPV4, tail.group()) + ours = IPV6_RE.fullmatch(a) is not None + try: + ipaddress.IPv6Address(a.decode("latin-1")) + theirs = b"%" not in a + except ValueError: + theirs = False + if ours != theirs: + bad.append(a) + return n, bad_tails, bad + + +def mutate_text(rng, s): + i = rng.randrange(len(s) + 1) + k = rng.randrange(4) + if k == 0: + return s[:i] + pick(rng, b"0123456789abcdef:.g") + s[i + 1:] + if k == 1: + return s[:i] + s[i + 1:] + if k == 2: + return s[:i] + pick(rng, b"0123456789abcdef:.") + s[i:] + return s + b":" + h16(rng) + + +def run_tool(data, timeout=TIMEOUT): + """The tool's answer lines for `data`, and a note on how the run + failed, or None. No right answer is longer than its request plus 64 + bytes, so a tool that writes more than that is stopped.""" + raw = data.encode("utf-8") + limit = 2 * len(raw) + 64 * (data.count("\n") + 1) + try: + proc = subprocess.Popen([str(EXE), "serve"], stdin=subprocess.PIPE, + stdout=subprocess.PIPE, stderr=subprocess.PIPE) + except OSError as e: + return [], f"could not run {EXE.relative_to(ROOT)}: {e.strerror or e}" + out, err = bytearray(), bytearray() + + def feed(): + try: + proc.stdin.write(raw) + proc.stdin.close() + except (BrokenPipeError, ValueError): + pass + + def drain(stream, buf, cap): + while chunk := stream.read1(1 << 16): + buf += chunk + if len(buf) > cap: + proc.kill() + return + + threads = [threading.Thread(target=feed), + threading.Thread(target=drain, args=(proc.stdout, out, limit)), + threading.Thread(target=drain, args=(proc.stderr, err, 1 << 20))] + for t in threads: + t.start() + problem = None + try: + proc.wait(timeout=timeout) + except subprocess.TimeoutExpired: + proc.kill() + problem = f"no end after {timeout} seconds" + for t in threads: + t.join() + proc.wait() + if len(out) > limit: + problem = problem or f"more than {limit} bytes of output, stopped" + elif proc.returncode != 0 and not problem: + tail = " / ".join(err.decode("utf-8", "backslashreplace").splitlines()[-3:]) + problem = f"exit status {proc.returncode}: {tail}" + text = bytes(out).decode("utf-8", "backslashreplace") + if text and not text.endswith("\n"): + problem = problem or "the last answer has no LF" + lines = text.split("\n") + if lines and lines[-1] == "": + lines.pop() + return lines, problem + + +def escape(bs): + return "".join(chr(b) if 0x20 <= b < 0x7F and b != 0x5C else f"\\x{b:02x}" for b in bs) + + +def check_answer(head): + """The lines `httphead check` must print for a head, or for None, and + its exit status: the head, a line for each field and the framing, or + `invalid`, and 0 only for a framed request.""" + if head is None: + return ["invalid"], 1 + method, target, major, minor, fields, _ = head + want = [f"{escape(method)} {escape(target)} HTTP/{major}.{minor}"] + want += [f"{escape(k)}: {escape(v)}" for k, v in fields] + fr = framing(head) + want.append(fr or "reject") + return want, 0 if fr else 1 + + +def check_mode(items, limit=2000): + """Runs `check` mode on the first `limit` inputs, each sent alone on + standard input. Each must print what check_answer says.""" + problems = [] + done = 0 + for label, req, _, _ in items: + if label == "error" or done >= limit: + continue + bs = bytes.fromhex(req.split(" ")[1]) + want, code_want = check_answer(reference(bs)) + run = subprocess.run([str(EXE), "check"], input=bs, capture_output=True, timeout=300) + got = run.stdout.decode("utf-8", "backslashreplace").split("\n")[:-1] + if got != want or run.returncode != code_want: + problems.append((f"check < {bs[:80]!r}", f"{want} exit {code_want}", + f"{got} exit {run.returncode}")) + done += 1 + run = subprocess.run([str(EXE)], capture_output=True, timeout=300) + if run.returncode != 2: + problems.append(("no arguments", "usage and exit 2", f"exit {run.returncode}")) + return done, problems + + +MB = 1 << 20 + + +def long_inputs(): + """(name, input, seconds) for each long input. The grammar sets no + limit on the length of a head. These inputs catch three faults an + earlier version of the code had: its stack grew with the length of a + line, and overflowed at about 10 MB; it converted a Content-Length + or a CONNECT port in time that grows with the square of the number + of digits; and the derivative of a Transfer-Encoding list grew by a + level for each space after a comma. The port of zeros then 443 must + be accepted, though it is long. Each run of the tool on one of them + must end within its seconds, which are at least 20 times the longest + it took in the runs made to set them. MB here is 2^20 octets, and KB + 2^10.""" + return [ + ("a request line of 16 MB", b"GET /" + b"a" * (16 * MB) + b" HTTP/1.1\r\nHost: a\r\n\r\n", 400), + ("a field value of 16 MB with a NUL at the end", + b"GET / HTTP/1.1\r\nHost: a\r\nX: " + b"a" * (16 * MB) + b"\x00\r\n\r\n", 150), + ("a Content-Length of 1,000,000 digits, 1234567890 repeated", + b"POST /a HTTP/1.1\r\nHost: a\r\nContent-Length: " + b"1234567890" * 100_000 + b"\r\n\r\n", 30), + ("a CONNECT port of 1,000,000 nines", + b"CONNECT a:" + b"9" * 1_000_000 + b" HTTP/1.1\r\nHost: a\r\n\r\n", 30), + ("a CONNECT port of 1,000,000 zeros, then 443", + b"CONNECT a:" + b"0" * 1_000_000 + b"443 HTTP/1.1\r\nHost: a\r\n\r\n", 30), + ("a Transfer-Encoding value with 64 KB of spaces after a comma", + b"POST /a HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked," + b" " * (64 << 10) + b",\r\n\r\n", + 10), + ] + + +def check_long(): + """Gives each long input to `httphead check` on standard input and to + `httphead serve`. Each answer must be the oracle's, and each run must + end within the seconds the input has. Returns the inputs, the number + of runs that were right in time, the seconds each run took, and the + problems.""" + inputs = long_inputs() + right, took, problems = 0, [], [] + for name, bs, seconds in inputs: + head = reference(bs) + want, code_want = check_answer(head) + start = time.monotonic() + try: + run = subprocess.run([str(EXE), "check"], input=bs, capture_output=True, timeout=seconds) + got = run.stdout.decode("utf-8", "backslashreplace").split("\n")[:-1] + problem = None if got == want and run.returncode == code_want else \ + f"{got[-1:]} exit {run.returncode}, {len(got)} lines" + except subprocess.TimeoutExpired: + problem = f"no end after {seconds} seconds" + took.append(time.monotonic() - start) + if problem: + problems.append((f"check < {name}", f"{want[-1:]} exit {code_want}, {len(want)} lines", + problem)) + else: + right += 1 + want = answer(bs, head) + start = time.monotonic() + got, problem = run_tool(f"head {bs.hex()}\n", timeout=seconds) + took.append(time.monotonic() - start) + if problem or got != [want]: + problems.append((f"serve: head {name}", want[-40:], + problem or (got[0][-40:] if len(got) == 1 else f"{len(got)} lines"))) + else: + right += 1 + return inputs, right, took, problems + + +def outcome(want): + """The oracle's answer, in short: refused by the grammar, or read and + then accepted or rejected.""" + if not want.startswith("OK"): + return "grammar" + return "rejected" if want.endswith("\treject") else "accepted" + + +def tally(answers): + n = {"accepted": 0, "rejected": 0, "grammar": 0} + for a in answers: + n[a] += 1 + return n + + +# Search patterns for the counts in TEST-RESULTS.md. They look at the +# octets of an input, so a mutated input counts when it still holds the +# pattern. +V4_TAIL = re.compile(rb"\[[0-9A-Fa-f:]*:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\]") +ZONE_ID = re.compile(rb"\[[0-9A-Fa-f:.]*:[0-9A-Fa-f:.]*%[^\]]*\]") +UPPER_V = re.compile(rb"\[V[0-9A-Fa-f]+\.[^\]]*\]") +SHORT_FUTURE = re.compile(rb"\[[vV]\.[^\]]*\]|\[[vV][0-9A-Fa-f]*\.\]") + + +def statistics(items): + """Lines for TEST-RESULTS.md that count how often the inputs reached + each form of target and each new rule.""" + targets = {"origin": 0, "absolute": 0, "authority": 0, "both": 0, "asterisk": 0, "literal": 0} + connect = {"accepted": 0, "empty host": 0, "port": 0, "form": 0, "other": 0} + ports = {"empty": 0, "zero": 0, "big": 0, "zeros": 0} + other_case = {"accepted": 0, "rejected": 0} + te = {"lines": 0, "empty": 0, "empty chunked": 0, "several": 0, "several chunked": 0} + bare_host = {"accepted": 0, "rejected": 0} + http = {"read": 0, "upper": 0, "accepted": 0, "no authority": 0, "empty host": 0, "userinfo": 0, + "other": 0, "elsewhere": 0} + http_connect = {"host and port": 0, "host and port accepted": 0, "other": 0, "other accepted": 0} + other_scheme = {"only": 0, "both": 0, "http": 0, "accepted": 0} + host_values = {"all": 0, "empty": 0, "empty accepted": 0, "empty host": 0, "empty host accepted": 0} + bad_tail, zone, upper_v, short_future = [], [], [], [] + for label, req, want, _ in items: + if label == "error": + continue + bs = bytes.fromhex(req.split(" ")[1]) + if any(not re.fullmatch(IPV4, m.group(1)) for m in V4_TAIL.finditer(bs)): + bad_tail.append(outcome(want)) + if ZONE_ID.search(bs): + zone.append(outcome(want)) + if UPPER_V.search(bs): + upper_v.append(outcome(want)) + if SHORT_FUTURE.search(bs): + short_future.append(outcome(want)) + head = reference(bs) + if head is None: + continue + method, t, _, _, fields, _ = head + fr = framing(head) + absolute = re.fullmatch(ABSOLUTE_URI, t) is not None + authority = re.fullmatch(AUTHORITY_FORM, t) is not None + if t == b"*": + targets["asterisk"] += 1 + elif t.startswith(b"/"): + targets["origin"] += 1 + elif absolute and authority: + targets["both"] += 1 + elif absolute: + targets["absolute"] += 1 + else: + targets["authority"] += 1 + if b"[" in t: + targets["literal"] += 1 + if method == b"CONNECT": + if fr: + connect["accepted"] += 1 + elif connect_ok(method, t): + connect["other"] += 1 + elif not authority: + connect["form"] += 1 + elif t.startswith(b":"): + connect["empty host"] += 1 + else: + connect["port"] += 1 + if authority: + p = t.rsplit(b":", 1)[1] + if p == b"": + ports["empty"] += 1 + elif p.strip(b"0") == b"": + ports["zero"] += 1 + elif len(p.lstrip(b"0")) > 5 or int(p.lstrip(b"0")) > 65535: + ports["big"] += 1 + elif p.startswith(b"0"): + ports["zeros"] += 1 + elif method.upper() == b"CONNECT": + other_case["accepted" if fr else "rejected"] += 1 + scheme = t.partition(b":")[0] + if http_scheme(t) and method == b"CONNECT": + form = "host and port" if CONNECT_TARGET.fullmatch(t) else "other" + http_connect[form] += 1 + http_connect[form + " accepted"] += fr is not None + elif http_scheme(t): + http["read"] += 1 + http["upper"] += scheme != scheme.lower() + problem = http_problem(t) + if problem: + http[problem] += 1 + else: + http["accepted" if fr else "elsewhere"] += 1 + elif absolute and method != b"CONNECT": + other_scheme["both" if authority else "only"] += 1 + other_scheme["http"] += scheme.lower().startswith(b"http") + other_scheme["accepted"] += fr is not None + values = [v for k, v in fields if k.lower() == b"transfer-encoding"] + if values: + te["lines"] += 1 + if any(e.strip(b" \t") == b"" for e in combined(values).split(b",")): + te["empty"] += 1 + te["empty chunked"] += fr == "chunked" + if len(values) > 1: + te["several"] += 1 + te["several chunked"] += fr == "chunked" + for k, v in fields: + if k.lower() != b"host": + continue + host_values["all"] += 1 + if v == b"": + host_values["empty"] += 1 + host_values["empty accepted"] += fr is not None + elif v.startswith(b":"): + host_values["empty host"] += 1 + host_values["empty host accepted"] += fr is not None + if b"[" not in v and v.count(b":") >= 2: + bare_host["accepted" if fr else "rejected"] += 1 + n_connect = sum(connect.values()) + + def read_or_not(answers): + n = tally(answers) + return (f"{len(answers)} inputs: {n['grammar']} refused by the grammar, " + f"{n['rejected']} read and rejected, {n['accepted']} read and accepted") + + return [ + f"- Targets of the heads read: {targets['origin']} origin-form, {targets['absolute']} " + f"absolute-form only, {targets['authority']} authority-form only, {targets['both']} that " + f"fit both absolute-form and authority-form (such as `a:1`), {targets['asterisk']} " + f"asterisk-form; {targets['literal']} with an IP literal", + f"- Heads read with the method `CONNECT`: {n_connect}. Accepted: {connect['accepted']}. " + f"Against the CONNECT rule, and so rejected: {connect['empty host']} with a host and " + f"port target whose host is empty, such as `:443`, {connect['port']} with a host and " + f"port target whose host is not empty and whose port is not from 1 to 65535, and " + f"{connect['form']} with a target of another form. Rejected only by another rule: " + f"{connect['other']}", + f"- Ports of those `CONNECT` targets that are a host and port: {ports['empty']} empty, " + f"{ports['zero']} zero, {ports['big']} above 65535, {ports['zeros']} from 1 to 65535 " + f"with leading zeros", + f"- Heads read with `connect` or another case of it, which is a different method: " + f"{sum(other_case.values())}, {other_case['accepted']} accepted, " + f"{other_case['rejected']} rejected", + f"- Heads read with a target whose scheme is http or https, in any case, and a method " + f"other than `CONNECT`: {http['read']}, {http['upper']} of them with upper case in the " + f"scheme. Accepted: {http['accepted']}. Against the rule of RFC 9110 section 4.2, and so " + f"rejected: {http['no authority']} with no `//` and so no authority, " + f"{http['empty host']} with an empty host, {http['userinfo']} with userinfo" + + (f", {http['other']} for another reason" if http["other"] else "") + + f". Rejected only by another rule: {http['elsewhere']}", + f"- Heads read with `CONNECT` and a target that starts with `http:` or `https:`, in any " + f"case: {http_connect['host and port'] + http_connect['other']}. " + f"Of them, {http_connect['host and port']} are a host and port, such as `http:80`, which " + f"names the host http or https, {http_connect['host and port accepted']} of them " + f"accepted; and {http_connect['other']} are of another form, such as `http://a:80/`, " + f"{http_connect['other accepted']} of them accepted", + f"- Heads read with a target of another scheme that fits absolute-form, and a method " + f"other than `CONNECT`, which that rule does not cover: " + f"{other_scheme['only'] + other_scheme['both']}, {other_scheme['only']} absolute-form " + f"only and {other_scheme['both']} that also fit authority-form, such as `x:443`; " + f"{other_scheme['http']} of them with a scheme that starts with `http`, such as `httpx`; " + f"{other_scheme['accepted']} accepted", + f"- Heads read with Transfer-Encoding: {te['lines']}. With an empty list element in the " + f"combined value: {te['empty']}, {te['empty chunked']} chunked and " + f"{te['empty'] - te['empty chunked']} rejected. With two or more Transfer-Encoding " + f"lines: {te['several']}, {te['several chunked']} chunked and " + f"{te['several'] - te['several chunked']} rejected", + f"- IPv6 literals with an IPv4 tail that is not four dec-octets, anywhere in the input, " + f"so also in a field that is not Host: {read_or_not(bad_tail)}", + f"- IP literals with a zone ID (`%` inside the brackets), anywhere in the input: " + f"{read_or_not(zone)}", + f"- IPvFuture with an upper-case `V`, anywhere in the input: {read_or_not(upper_v)}", + f"- IPvFuture with no hex digit or nothing after the dot, such as `[v.a]` or `[v1.]`, " + f"which RFC 3986 does not allow, anywhere in the input: {read_or_not(short_future)}", + f"- Host values of the heads read: {host_values['all']}. Empty: {host_values['empty']}, " + f"{host_values['empty accepted']} of them in an accepted head. With an empty host before " + f"a colon, such as `:80` or `:`: {host_values['empty host']}, " + f"{host_values['empty host accepted']} of them in an accepted head", + f"- Host values of the heads read that hold two or more colons and no `[`, such as an " + f"IPv6 address with no brackets: {sum(bare_host.values())}, {bare_host['accepted']} " + f"in an accepted head", + ] + + +def oracle(): + return (f"Python {platform.python_version()}: the grammar and framing rules of RFC 9112, " + f"RFC 9110 and RFC 3986 written in this script, with its IPv6 rule checked " + f"against `ipaddress`") + + +def lean_version(): + try: + out = subprocess.run(["lake", "env", "lean", "--version"], cwd=ROOT, + capture_output=True, text=True, errors="backslashreplace", + timeout=300) + first = out.stdout.strip().splitlines()[:1] + return first[0] if first else "unknown" + except (OSError, subprocess.TimeoutExpired): + return "unknown" + + +def count(text): + n = int(text) + if n < 1: + raise argparse.ArgumentTypeError("the count must be at least 1") + return n + + +def write(lines): + RESULTS.write_text("\n".join(lines), encoding="utf-8") + + +def main(): + ap = argparse.ArgumentParser() + ap.add_argument("--seed", type=int, default=20261025) + ap.add_argument("--count", type=count, default=300_000) + args = ap.parse_args() + + # Always build, so the tests never run an executable older than the code. + try: + build = subprocess.run(["lake", "build", "httphead"], cwd=ROOT, capture_output=True, + text=True, errors="backslashreplace", timeout=BUILD_TIMEOUT) + built, log = build.returncode == 0, build.stdout + build.stderr + except (OSError, subprocess.TimeoutExpired) as e: + built, log = False, str(e) + if not built: + write(["# Test results", "", f"- Oracle: {oracle()}", f"- Seed: {args.seed}", + "- Inputs: 0", "- Failures: 1 (`lake build httphead` failed)", ""]) + sys.exit("lake build httphead failed:\n" + log) + + ipv6_count, ipv6_bad_tails, ipv6_bad = check_ipv6_oracle(args.seed) + failures = [(f"IPv6 rule on {a!r}", "the same verdict as ipaddress", "a different one") + for a in ipv6_bad] + + items = list(cases(args.seed, args.count)) + # Every seventh request ends in CR LF, which the tool must take as LF. + out, problem = run_tool("".join(req + ("\r\n" if i % 7 == 6 else "\n") + for i, (_, req, _, _) in enumerate(items))) + if problem: + failures.append(("(whole run)", "a clean run", problem)) + for item, got in itertools.zip_longest(items, out): + if item is None: + failures.append(("(no request)", "nothing", got)) + elif got != item[2]: + failures.append((item[1], item[2], "(no answer)" if got is None else got)) + + checked, check_problems = check_mode(items) + failures += check_problems + + long, long_right, long_took, long_problems = check_long() + failures += long_problems + + got, problem = run_tool(f"head {FIXED[0].hex()}", timeout=60) + eof_right = got == [answer(FIXED[0])] and not problem + if not eof_right: + failures.append(("a last line with no LF", answer(FIXED[0]), f"{got} {problem or ''}")) + + by_label = {} + for label, _, _, _ in items: + by_label[label] = by_label.get(label, 0) + 1 + heads = [want for label, _, want, _ in items if label != "error"] + read = [w for w in heads if w.startswith("OK")] + frames = [w.split("\t")[3] for w in read] + stats = statistics(items) + mutated = sum(1 for item in items if item[3]) + malformed = [g for item, g in zip(items, out) if item[0] == "error"] + + lines = [ + "# Test results", + "", + "Written by `tests/run_tests.py`. Rerun it to check these numbers.", + "", + f"- Oracle: {oracle()}", + f"- Lean: {lean_version()}", + f"- Seed: {args.seed}", + f"- Inputs: {len(items)}", + f"- Mutated: {mutated} of the inputs are mutated heads", + f"- By kind: " + ", ".join(f"{k} {v}" for k, v in sorted(by_label.items())), + f"- Heads read: {len(read)} of {len(heads)}, and {len(heads) - len(read)} refused by the grammar", + f"- Framing of the heads read: {sum(1 for f in frames if f == 'length 0')} with no body, " + f"{sum(1 for f in frames if f.startswith('length') and f != 'length 0')} with a length, " + f"{frames.count('chunked')} chunked, {frames.count('reject')} rejected", + ] + stats + [ + f"- IPv6 addresses checked against `ipaddress`, to test the oracle: {ipv6_count}, of " + f"them {ipv6_bad_tails} with an IPv4 tail that is not four dec-octets; " + f"{len(ipv6_bad)} disagreements", + f"- Malformed requests answered `error`: {malformed.count('error')} of " + f"{by_label.get('error', 0)}", + f"- Requests ending in CR LF: every seventh, {len(items) // 7}", + f"- Inputs also given to `httphead check` on standard input: {checked}, and once with no " + f"arguments", + f"- Long inputs, each given to `httphead check` on standard input and to `httphead serve`, " + f"each run within the time in brackets: " + + "; ".join(f"{name} ({seconds} s)" for name, _, seconds in long) + + f". Runs answered right in time: {long_right} of {2 * len(long)}", + f"- A last line with no LF, sent alone, answered right: {'yes' if eof_right else 'no'}", + f"- Failures: {len(failures)}", + "", + ] + if failures: + lines += ["## Failures", ""] + lines += [f"- `{req[:160]!r}`: expected `{want[:120]!r}`, got `{got[:120]!r}`" + for req, want, got in failures[:50]] + lines.append("") + write(lines) + agree = sum(1 for item, got in zip(items, out) if got == item[2]) + print(f"{agree}/{len(items)} inputs agree, {len(failures)} failures; results in {RESULTS}") + return 1 if failures else 0 + + +if __name__ == "__main__": + sys.exit(main())