From df19f5359f6aeaa9f54a5da4ddc7482727fae8af Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Mon, 1 Jul 2019 14:52:38 +0200 Subject: [PATCH 1/7] Replace internal hpack library --- .gitmodules | 3 - esy.json | 4 +- esy.lock/index.json | 24 ++- hpack.opam | 27 --- hpack/original.LICENSE | 22 -- hpack/src/decoder.ml | 230 --------------------- hpack/src/dune | 11 - hpack/src/dynamic_table.ml | 147 -------------- hpack/src/encoder.ml | 343 ------------------------------- hpack/src/hpack.ml | 35 ---- hpack/src/hpack.mli | 93 --------- hpack/src/huffman.ml | 122 ----------- hpack/src/static_table.ml | 382 ----------------------------------- hpack/src/types.ml | 39 ---- hpack/test/dune | 13 -- hpack/test/hpack-test-case | 1 - hpack/test/test.ml | 325 ----------------------------- hpack/util/dune | 3 - hpack/util/gen_huffman.ml | 219 -------------------- hpack/util/gen_static.ml | 224 -------------------- hpack/util/huffman_table.txt | 257 ----------------------- hpack/util/static_table.txt | 61 ------ hpack/util/syntax.ml | 5 - 23 files changed, 26 insertions(+), 2564 deletions(-) delete mode 100644 hpack.opam delete mode 100644 hpack/original.LICENSE delete mode 100644 hpack/src/decoder.ml delete mode 100644 hpack/src/dune delete mode 100644 hpack/src/dynamic_table.ml delete mode 100644 hpack/src/encoder.ml delete mode 100644 hpack/src/hpack.ml delete mode 100644 hpack/src/hpack.mli delete mode 100644 hpack/src/huffman.ml delete mode 100644 hpack/src/static_table.ml delete mode 100644 hpack/src/types.ml delete mode 100644 hpack/test/dune delete mode 160000 hpack/test/hpack-test-case delete mode 100644 hpack/test/test.ml delete mode 100644 hpack/util/dune delete mode 100644 hpack/util/gen_huffman.ml delete mode 100644 hpack/util/gen_static.ml delete mode 100644 hpack/util/huffman_table.txt delete mode 100644 hpack/util/static_table.txt delete mode 100644 hpack/util/syntax.ml diff --git a/.gitmodules b/.gitmodules index cff096dc..a592a053 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,3 @@ -[submodule "hpack/test/hpack-test-case"] - path = hpack/test/hpack-test-case - url = git@github.com:http2jp/hpack-test-case.git [submodule "lib_test/http2-frame-test-case"] path = lib_test/http2-frame-test-case url = git@github.com:http2jp/http2-frame-test-case.git diff --git a/esy.json b/esy.json index 591603fa..0f250651 100644 --- a/esy.json +++ b/esy.json @@ -12,6 +12,7 @@ "@opam/bigstringaf": "*", "@opam/angstrom": "*", "@opam/faraday": "*", + "@opam/hpack": "*", "@opam/psq": "*", "@opam/mirage-conduit": "*", "@opam/faraday-lwt-unix": "*", @@ -89,6 +90,7 @@ }, "@opam/tls": "dune-universe/ocaml-tls:tls.opam#9761033", "@opam/tls-lwt": "dune-universe/ocaml-tls:tls-lwt.opam#9761033", - "@opam/tls-mirage": "dune-universe/ocaml-tls:tls-mirage.opam#9761033" + "@opam/tls-mirage": "dune-universe/ocaml-tls:tls-mirage.opam#9761033", + "@opam/hpack": "314eter/ocaml-hpack:hpack.opam#9be540d" } } diff --git a/esy.lock/index.json b/esy.lock/index.json index b9873268..91cec7bf 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "7677c103d74a45a530a6bc4e593bb0e5", + "checksum": "04c99fb49954ba2fae6bdfb8c449927a", "root": "h2@link-dev:./esy.json", "node": { "yarn-pkg-config@github:esy-ocaml/yarn-pkg-config#cca65f99674ed2d954d28788edeb8c57fada5ed0@d41d8cd9": { @@ -47,6 +47,7 @@ "@opam/lwt_ssl@opam:1.1.2@ac833920", "@opam/lwt@opam:4.2.1@c1888ec9", "@opam/httpaf-lwt-unix@github:anmonteiro/httpaf:httpaf-lwt-unix.opam#6d2c80e@33b6fb1d", "@opam/httpaf@github:inhabitedtype/httpaf:httpaf.opam#fa9dc4e@d41d8cd9", + "@opam/hpack@github:314eter/ocaml-hpack:hpack.opam#9be540d@d41d8cd9", "@opam/faraday-lwt-unix@opam:0.7.0@b0dea04f", "@opam/faraday@opam:0.7.0@6026a81f", "@opam/dune@opam:1.10.0@b15ce221", @@ -2414,6 +2415,27 @@ "@opam/angstrom@opam:0.11.2@2e02b026" ] }, + "@opam/hpack@github:314eter/ocaml-hpack:hpack.opam#9be540d@d41d8cd9": { + "id": + "@opam/hpack@github:314eter/ocaml-hpack:hpack.opam#9be540d@d41d8cd9", + "name": "@opam/hpack", + "version": "github:314eter/ocaml-hpack:hpack.opam#9be540d", + "source": { + "type": "install", + "source": [ "github:314eter/ocaml-hpack:hpack.opam#9be540d" ] + }, + "overrides": [], + "dependencies": [ + "ocaml@4.8.0@d41d8cd9", "@opam/faraday@opam:0.7.0@6026a81f", + "@opam/dune@opam:1.10.0@b15ce221", + "@opam/angstrom@opam:0.11.2@2e02b026", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.8.0@d41d8cd9", "@opam/faraday@opam:0.7.0@6026a81f", + "@opam/angstrom@opam:0.11.2@2e02b026" + ] + }, "@opam/hex@opam:1.4.0@70cc7ec2": { "id": "@opam/hex@opam:1.4.0@70cc7ec2", "name": "@opam/hex", diff --git a/hpack.opam b/hpack.opam deleted file mode 100644 index fca55143..00000000 --- a/hpack.opam +++ /dev/null @@ -1,27 +0,0 @@ -opam-version: "2.0" -maintainer: "Antonio Nuno Monteiro " -authors: [ "Pieter Goetschalckx <3.14.e.ter@gmail.com>" - "Antonio Nuno Monteiro " ] -license: "BSD-3-clause" -homepage: "https://github.com/anmonteiro/ocaml-h2" -bug-reports: "https://github.com/anmonteiro/ocaml-h2/issues" -dev-repo: "git+https://github.com/anmonteiro/ocaml-h2.git" -doc: "https://anmonteiro.github.io/ocaml-h2/" -depends: [ - "ocaml" {>= "4.04"} - "dune" {build} - "yojson" {with-test} - "hex" {with-test} - "angstrom" - "faraday" -] -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -synopsis: - "An HPACK (Header Compression for HTTP/2) implementation in OCaml" -description: """ -hpack is an implementation of the HPACK: Header Compression for HTTP/2 -specification (RFC7541) written in OCaml. It uses Angstrom and Faraday for -parsing and serialization, respectively. -""" diff --git a/hpack/original.LICENSE b/hpack/original.LICENSE deleted file mode 100644 index 223a7ea7..00000000 --- a/hpack/original.LICENSE +++ /dev/null @@ -1,22 +0,0 @@ -This HPACK library is based on some initial work by Pieter Goetschalckx. The -original license is reproduced below. - -Copyright (C) 2018 Pieter Goetschalckx - -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/hpack/src/decoder.ml b/hpack/src/decoder.ml deleted file mode 100644 index 1a7c00c4..00000000 --- a/hpack/src/decoder.ml +++ /dev/null @@ -1,230 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -open Types -open Angstrom - -type t = - { table : Dynamic_table.t - ; max_capacity : int - } - -let create max_capacity = - { table = Dynamic_table.create max_capacity; max_capacity } - -let set_capacity { table; max_capacity } capacity = - if capacity > max_capacity then - (* From RFC7541§6.3: - * The new maximum size MUST be lower than or equal to the limit - * determined by the protocol using HPACK. A value that exceeds this - * limit MUST be treated as a decoding error. *) - Error Decoding_error - else ( - Dynamic_table.set_capacity table capacity; - Ok ()) - -let[@inline] ok x = return (Ok x) - -let[@inline] error x = return (Error x) - -(* From RFC7541§5.1: - * decode I from the next N bits. *) -let decode_int prefix n = - let max_prefix = (1 lsl n) - 1 in - let i = prefix land max_prefix in - if i < max_prefix then - return i - else - let rec loop i m = - any_uint8 >>= fun b -> - let i = i + ((b land 127) lsl m) in - if b land 0b1000_0000 == 0b1000_0000 then - loop i (m + 7) - else - return i - in - loop i 0 - -let decode_string = - any_uint8 >>= fun h -> - (* From RFC7541§5.2: - * The number of octets used to encode the string literal, encoded as an - * integer with a 7-bit prefix (see Section 5.1). *) - decode_int h 7 >>= fun string_length -> - lift - (fun string_data -> - (* From RFC7541§5.2: - * A one-bit flag, H, indicating whether or not the octets of the - * string are Huffman encoded. *) - if h land 0b1000_0000 == 0 then - Ok string_data - else - Huffman.decode string_data) - (take string_length) - -let get_indexed_field table index = - let static_table_size = Static_table.table_size in - let dynamic_table_size = Dynamic_table.table_size table in - (* From RFC7541§6.1: - * The index value of 0 is not used. It MUST be treated as a decoding - * error if found in an indexed header field representation. *) - if - index == 0 - || (* From RFC7541§2.3.3: - * Indices strictly greater than the sum of the lengths of both tables - * MUST be treated as a decoding error. *) - index > static_table_size + dynamic_table_size - then - Error Decoding_error - else if index <= static_table_size then - (* From RFC7541§2.3.3: - * Indices between 1 and the length of the static table (inclusive) refer - * to elements in the static table (see Section 2.3.1). *) - Ok Static_table.table.(index - 1) - else - (* From RFC7541§2.3.3: - * Indices strictly greater than the length of the static table refer to - * elements in the dynamic table (see Section 2.3.2). The length of the - * static table is subtracted to find the index into the dynamic - * table. *) - Ok (Dynamic_table.get table (index - static_table_size - 1)) - -let decode_header_field table prefix prefix_length = - decode_int prefix prefix_length >>= fun index -> - lift2 - (fun name value -> - match name, value with - | Ok name, Ok value -> - Ok (name, value) - | Error e, _ | _, Error e -> - Error e) - (* From RFC7541§6.2.1: - * If the header field name matches the header field name of an entry - * stored in the static table or the dynamic table, the header field - * name can be represented using the index of that entry. In this case, - * [...] This value is always non-zero. - * - * Otherwise, the header field name is represented as a string literal - * (see Section 5.2). A value 0 is used in place [...], followed by the - * header field name. *) - (if index == 0 then - decode_string - else - match get_indexed_field table index with - | Ok (name, _) -> - ok name - | Error e -> - error e) - decode_string - -let decode_headers ({ table; _ } as t) = - let rec loop acc saw_first_header = - at_end_of_input >>= fun is_eof -> - if is_eof then - ok acc - else - any_uint8 >>= fun b -> - if b land 0b1000_0000 != 0 then - (* From RFC7541§6.1: Indexed Header Field Representation - * An indexed header field starts with the '1' 1-bit pattern, - * followed by the index of the matching header field, represented as - * an integer with a 7-bit prefix (see Section 5.1). *) - decode_int b 7 >>= fun index -> - match get_indexed_field table index with - | Ok (name, value) -> - loop ({ name; value; sensitive = false } :: acc) true - | Error e -> - error e - else if b land 0b1100_0000 == 0b0100_0000 then - (* From RFC7541§6.2.1: Literal Header Field with Incremental Indexing - * A literal header field with incremental indexing representation - * starts with the '01' 2-bit pattern. In this case, the index of the - * entry is represented as an integer with a 6-bit prefix (see - * Section 5.1). *) - decode_header_field table b 6 >>= function - | Ok (name, value) -> - (* From RFC7541§6.2.1: Literal Header Field with Incremental Indexing - * A literal header field with incremental indexing representation - * results in appending a header field to the decoded header list - * and inserting it as a new entry into the dynamic table. *) - Dynamic_table.add table (name, value); - loop ({ name; value; sensitive = false } :: acc) true - | Error e -> - error e - else if b land 0b1111_0000 == 0 then - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * A literal header field without indexing representation starts with - * the '0000' 4-bit pattern. In this case, the index of the entry is - * represented as an integer with a 4-bit prefix (see Section - * 5.1). *) - decode_header_field table b 4 >>= function - | Ok (name, value) -> - loop ({ name; value; sensitive = false } :: acc) true - | Error e -> - error e - else if b land 0b1111_0000 == 0b0001_0000 then - (* From RFC7541§6.2.3: Literal Header Field Never Indexed - * A literal header field without indexing representation starts with - * the '0001' 4-bit pattern. - * The encoding of the representation is identical to the literal - * header field without indexing (see Section 6.2.2). *) - decode_header_field table b 4 >>= function - | Ok (name, value) -> - loop ({ name; value; sensitive = true } :: acc) true - | Error e -> - error e - else if b land 0b1110_0000 == 0b0010_0000 then - if - (* From RFC7541§6.3: Dynamic Table Size Update - * A dynamic table size update signals a change to the size of the - * dynamic table. - * A dynamic table size update starts with the '001' 3-bit - * pattern *) - saw_first_header - then - (* From RFC7541§4.2: Maximum Table Size - * A change in the maximum size of the dynamic table is signaled - * via a dynamic table size update (see Section 6.3). This dynamic - * table size update MUST occur at the beginning of the first - * header block following the change to the dynamic table size. *) - error Decoding_error - else - decode_int b 5 >>= fun capacity -> - match set_capacity t capacity with - | Ok () -> - loop acc saw_first_header - | Error e -> - error e - else - error Decoding_error - in - loop [] false diff --git a/hpack/src/dune b/hpack/src/dune deleted file mode 100644 index b96a6d5a..00000000 --- a/hpack/src/dune +++ /dev/null @@ -1,11 +0,0 @@ -(library - (public_name hpack) - (libraries angstrom faraday)) - -(rule - (targets huffman_table.ml) - (deps ../util/huffman_table.txt) - (action - (with-stdout-to - %{targets} - (run ../util/gen_huffman.exe %{deps})))) diff --git a/hpack/src/dynamic_table.ml b/hpack/src/dynamic_table.ml deleted file mode 100644 index bb9ec527..00000000 --- a/hpack/src/dynamic_table.ml +++ /dev/null @@ -1,147 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -type t = - { mutable entries : (string * string * int) array - ; mutable length : int - ; mutable offset : int - ; mutable capacity : int - (* `length` above is the number of entries in the dynamic table. We - * track the HPACK size in `size`. - * - * From RFC7541§4.1: - * The size of the dynamic table is the sum of the size of its - * entries. - * - * The size of an entry is the sum of its name's length in octets (as - * defined in Section 5.2), its value's length in octets, and 32. *) - ; mutable size : int - (* From RFC7541§4.2: - * Protocols that use HPACK determine the maximum size that the - * encoder is permitted to use for the dynamic table. In HTTP/2, this - * value is determined by the SETTINGS_HEADER_TABLE_SIZE setting (see - * Section 6.5.2 of [HTTP2]). *) - ; mutable max_size : int - ; on_evict : string * string -> unit - } - -(* From RFC7541§4.1: - * The size of an entry is the sum of its name's length in octets (as defined - * in Section 5.2), its value's length in octets, and 32. *) -let default_entry = "", "", 32 - -let default_evict = Sys.opaque_identity (fun _ -> ()) - -let create ?(on_evict = default_evict) max_size = - let capacity = max 256 max_size in - { entries = Array.make capacity default_entry - ; length = 0 - ; offset = 0 - ; capacity - ; size = 0 - ; max_size - ; on_evict - } - -let[@inline] _get table i = - table.entries.((table.offset + i) mod table.capacity) - -let[@inline] get table i = - let name, value, _ = _get table i in - name, value - -let[@inline] entry_size name value = - (* From RFC7541§4.1: - * The size of an entry is the sum of its name's length in octets (as - * defined in Section 5.2), its value's length in octets, and 32. *) - String.length name + String.length value + 32 - -(* Note: Assumes table.size is positive. Doesn't perform any checking. *) -let evict_one ({ capacity; entries; on_evict; _ } as table) = - table.length <- table.length - 1; - let i = (table.offset + table.length) mod capacity in - let name, value, entry_size = entries.(i) in - entries.(i) <- default_entry; - table.size <- table.size - entry_size; - - (* Don't bother calling if the eviction callback is not meaningful. *) - if on_evict != default_evict then - on_evict (name, value) - -let increase_capacity table = - let new_capacity = 2 * table.capacity in - let new_entries = - Array.init new_capacity (fun i -> - if i < table.length then - _get table i - else - default_entry) - in - table.entries <- new_entries; - table.offset <- 0; - table.capacity <- new_capacity - -let add ({ max_size; _ } as table) (name, value) = - let entry_size = entry_size name value in - (* From RFC7541§4.4: - * Before a new entry is added to the dynamic table, entries are evicted - * from the end of the dynamic table until the size of the dynamic table is - * less than or equal to (maximum size - new entry size) or until the table - * is empty. *) - while table.size > 0 && table.size + entry_size > max_size do - evict_one table - done; - - (* From RFC7541§4.4: - * If the size of the new entry is less than or equal to the maximum size, - * that entry is added to the table. *) - if table.size + entry_size <= max_size then ( - if table.length = table.capacity then - increase_capacity table; - table.length <- table.length + 1; - table.size <- table.size + entry_size; - let new_offset = (table.offset + table.capacity - 1) mod table.capacity in - table.entries.(new_offset) <- (name, value, entry_size); - table.offset <- new_offset) - -let[@inline] table_size table = table.length - -let set_capacity table max_size = - table.max_size <- max_size; - - (* From RFC7541§4.3: - * Whenever the maximum size for the dynamic table is reduced, entries are - * evicted from the end of the dynamic table until the size of the dynamic - * table is less than or equal to the maximum size. *) - while table.size > max_size do - evict_one table - done diff --git a/hpack/src/encoder.ml b/hpack/src/encoder.ml deleted file mode 100644 index a5bb228c..00000000 --- a/hpack/src/encoder.ml +++ /dev/null @@ -1,343 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -open Types - -module IntSet = Set.Make (struct - type t = int - - let compare = compare -end) - -module HeaderFieldsTbl = struct - include Hashtbl.Make (struct - type t = string - - let equal = String.equal - - let hash s = Hashtbl.hash s - end) - - let[@inline] find_opt h key = try Some (find h key) with Not_found -> None -end - -module ValueMap = struct - include Map.Make (String) - - let[@inline] find_opt k m = try Some (find k m) with Not_found -> None -end - -type t = - { table : Dynamic_table.t - (* We maintain a lookup table of header fields to their indexes in the - * dynamic table. The format is name -> (value -> index) *) - ; lookup_table : int ValueMap.t HeaderFieldsTbl.t - ; mutable next_seq : int - } - -module BinaryFormat = struct - (* From RFC7541§6.2.3. Literal Header Field Never Indexed - * A literal header field never-indexed representation starts with the - * '0001' 4-bit pattern. *) - let never_indexed = 0b0001_0000, 4 - - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * A literal header field without indexing representation starts with the - * '0000' 4-bit pattern. *) - let without_indexing = 0b0000_0000, 4 - - (* From RFC7541§6.2.1: Literal Header Field with Incremental Indexing - * A literal header field with incremental indexing representation starts - * with the '01' 2-bit pattern. *) - let incremental_indexing = 0b0100_0000, 6 - - (* From RFC7541§6.1: Indexed Header Field Representation - * An indexed header field starts with the '1' 1-bit pattern, followed by - * the index of the matching header field, represented as an integer with - * a 7-bit prefix (see Section 5.1). *) - let indexed = 0b1000_0000, 7 - - let[@inline] is_indexed = function 128 -> true | _ -> false -end - -let on_evict lookup_table (name, value) = - let map = HeaderFieldsTbl.find lookup_table name in - if ValueMap.cardinal map = 1 then - HeaderFieldsTbl.remove lookup_table name - else - let map = ValueMap.remove value map in - HeaderFieldsTbl.replace lookup_table name map - -let create capacity = - let lookup_table = HeaderFieldsTbl.create capacity in - { table = Dynamic_table.create ~on_evict:(on_evict lookup_table) capacity - ; lookup_table - ; next_seq = 0 - } - -let add ({ table; lookup_table; next_seq } as encoder) entry = - let name, value = entry in - Dynamic_table.add table entry; - let map = - match HeaderFieldsTbl.find_opt lookup_table name with - | Some map -> - ValueMap.add value next_seq map - | None -> - ValueMap.singleton value next_seq - in - encoder.next_seq <- next_seq + 1; - HeaderFieldsTbl.replace lookup_table name map - -let[@inline] find_token encoder without_indexing token name value = - let rec loop i = - let name', value' = Static_table.table.(i) in - if name' = name then - if value' = value then - (* From RFC7541§6.1: Indexed Header Field Representation - * An indexed header field starts with the '1' 1-bit pattern, - * followed by the index of the matching header field. *) - BinaryFormat.indexed, i + 1 - else - (* Advance one token in the static table, as the next entry might have - * a value that can fall into the above branch. We're guaranteed to - * always get the first token (index) in the static table for `name`, - * because that's what `Static_table.lookup_token` returns. *) - loop (i + 1) - else - (* This is a header field whose value we didn't find in the static table - * after looping. We ended here (name <> name') because we looped to - * check whether the value was indexed in the static table. We can still - * use the token index to encode the header name. *) - let index = token + 1 in - if without_indexing then - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * If the header field name matches the header field name of an entry - * stored in the static table or the dynamic table, the header field - * name can be represented using the index of that entry. *) - BinaryFormat.without_indexing, index - else ( - (* From RFC7541§6.2.1: Literal Header Field with Incremental Indexing - * A literal header field with incremental indexing representation - * results in appending a header field to the decoded header list and - * inserting it as a new entry into the dynamic table. *) - add encoder (name, value); - BinaryFormat.incremental_indexing, index) - in - loop token - -let[@inline] seq_to_index next_seq seq = - Static_table.table_size + next_seq - seq - -let tokens_without_indexing = - (* From RFC7541§6.2.2: Never-Indexed Literals - * Either form of header field name representation is followed by the - * header field value represented as a string literal (see Section 5.2). - * - * Note: we choose not to index the values of these fields as they would - * vary immensely. This way, we save some additions / evictions from the - * dynamic table. *) - IntSet.of_list - Static_table.TokenIndices. - [ path - ; age - ; content_length - ; etag - ; if_modified_since - ; if_none_match - ; location - ; set_cookie - ] - -let[@inline] is_without_indexing token = - token <> -1 && IntSet.mem token tokens_without_indexing - -let[@inline] is_sensitive token value = - token <> -1 - && (* From RFC7541§7.1.3: Never-Indexed Literals - * An encoder might also choose not to index values for header fields - * that are considered to be highly valuable or sensitive to recovery, - * such as the Cookie or Authorization header fields. *) - Static_table.TokenIndices.( - token == authorization || (token == cookie && String.length value < 20)) - -let encode - ({ lookup_table; next_seq; _ } as encoder) { name; value; sensitive } - = - let token = Static_table.lookup_token_index name in - let token_found_in_static_table = token <> -1 in - if sensitive || is_sensitive token value then - (* never indexed literal header field, find the index *) - let index = - if token_found_in_static_table then - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * If the header field name matches the header field name of an entry - * stored in the static table or the dynamic table, the header field - * name can be represented using the index of that entry. *) - token + 1 - else - match HeaderFieldsTbl.find_opt lookup_table name with - | Some map -> - let _, any_entry = ValueMap.choose map in - seq_to_index next_seq any_entry - | None -> - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * Otherwise, the header field name is represented as a string - * literal (see Section 5.2). A value 0 is used in place of the - * 4-bit index, followed by the header field name. *) - 0 - in - BinaryFormat.never_indexed, index - else if token_found_in_static_table then - (* Header name is represented in the static table. *) - match HeaderFieldsTbl.find_opt lookup_table name with - | Some map -> - (* Header value is indexed in the dynamic table. *) - (match ValueMap.find_opt value map with - | Some seq -> - (* From RFC7541§6.1: Indexed Header Field Representation - * An indexed header field representation identifies an entry in - * either the static table or the dynamic table (see Section 2.3). *) - BinaryFormat.indexed, seq_to_index next_seq seq - | None -> - (* Header value is not indexed in the dynamic table. Check if it's an - * entry in the static table or if we need to encode its value, (and - * potentially name if the field is requested to be encoded without - * indexing). *) - let without_indexing = is_without_indexing token in - find_token encoder without_indexing token name value) - | None -> - let without_indexing = is_without_indexing token in - find_token encoder without_indexing token name value - else - match HeaderFieldsTbl.find_opt lookup_table name with - | Some map -> - (match ValueMap.find_opt value map with - | Some seq -> - BinaryFormat.indexed, seq_to_index next_seq seq - | None -> - let index = seq_to_index next_seq (snd (ValueMap.choose map)) in - if is_without_indexing token then - BinaryFormat.without_indexing, index - else ( - (* From RFC7541§6.2.1 - * A literal header field with incremental indexing representation - * results in appending a header field to the decoded header list - * and inserting it as a new entry into the dynamic table. *) - add encoder (name, value); - BinaryFormat.incremental_indexing, index)) - | None -> - if is_without_indexing token then - BinaryFormat.without_indexing, 0 - else ( - (* From RFC7541§6.2.1 - * A literal header field with incremental indexing representation - * results in appending a header field to the decoded header list and - * inserting it as a new entry into the dynamic table. *) - add encoder (name, value); - BinaryFormat.incremental_indexing, 0) - -let[@inline] encode_int t prefix n i = - let max_prefix = (1 lsl n) - 1 in - if i < max_prefix then - (* From RFC7541§5.1: - * If the integer value is small enough, i.e., strictly less than 2^N-1, - * it is encoded within the N-bit prefix. *) - Faraday.write_uint8 t (prefix lor i) - else - (* From RFC7541§5.1: - * Otherwise, all the bits of the prefix are set to 1, and the value, - * decreased by 2^N-1, is encoded using a list of one or more octets. The - * most significant bit of each octet is used as a continuation flag: its - * value is set to 1 except for the last octet in the list. The remaining - * bits of the octets are used to encode the decreased value. *) - let i = i - max_prefix in - Faraday.write_uint8 t (prefix lor max_prefix); - let rec loop i = - if i >= 128 then ( - Faraday.write_uint8 t (i land 127 lor 128); - loop (i lsr 7)) - else - Faraday.write_uint8 t i - in - loop i - -let[@inline] encode_string t s = - let string_length = String.length s in - let huffman_length = Huffman.encoded_length s in - if huffman_length > string_length then ( - (* From RFC7541§5.2: - * The number of octets used to encode the string literal, encoded as an - * integer with a 7-bit prefix (see Section 5.1). *) - encode_int t 0 7 string_length; - - (* From RFC7541§5.2: - * The encoded data of the string literal. If H is '0', then the encoded - * data is the raw octets of the string literal. If H is '1', then the - * encoded data is the Huffman encoding of the string literal. *) - Faraday.write_string t s) - else ( - (* From RFC7541§5.2: - * The number of octets used to encode the string literal, encoded as an - * integer with a 7-bit prefix (see Section 5.1). *) - encode_int t 128 7 huffman_length; - - (* From RFC7541§5.2: - * The encoded data of the string literal. If H is '0', then the encoded - * data is the raw octets of the string literal. If H is '1', then the - * encoded data is the Huffman encoding of the string literal. *) - Huffman.encode t s) - -let encode_header encoder t ({ name; value; _ } as header) = - let (prefix, prefix_length), index = encode encoder header in - encode_int t prefix prefix_length index; - if not (BinaryFormat.is_indexed prefix) then ( - if index == 0 then - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * If the header field name matches the header field name of an entry - * stored in the static table or the dynamic table, the header field - * name can be represented using the index of that entry. In this case, - * the index of the entry is represented as an integer with a 4-bit - * prefix (see Section 5.1). This value is always non-zero. - * - * Otherwise, the header field name is represented as a string literal - * (see Section 5.2). A value 0 is used in place of the 4-bit index, - * followed by the header field name. *) - encode_string t name; - - (* From RFC7541§6.2.2: Literal Header Field without Indexing - * Either form of header field name representation is followed by the - * header field value represented as a string literal (see - * Section 5.2). *) - encode_string t value) - -let set_capacity { table; _ } new_capacity = - Dynamic_table.set_capacity table new_capacity diff --git a/hpack/src/hpack.ml b/hpack/src/hpack.ml deleted file mode 100644 index c02ad3bd..00000000 --- a/hpack/src/hpack.ml +++ /dev/null @@ -1,35 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -include Types -module Encoder = Encoder -module Decoder = Decoder diff --git a/hpack/src/hpack.mli b/hpack/src/hpack.mli deleted file mode 100644 index 608cc6dd..00000000 --- a/hpack/src/hpack.mli +++ /dev/null @@ -1,93 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -type header = - { name : string - ; value : string - (* From RFC7541§7.1.3: - * Implementations can also choose to protect sensitive header fields - * by not compressing them and instead encoding their value as - * literals. *) - ; sensitive : bool - } - -type error = Decoding_error - -module Encoder : sig - type t - - val create : int -> t - (** [create capacity] initializes an encoder with a dynamic table with - maximum size [capacity]. This size is an approximation of the memory - overhead in bytes. - - See {{:https://tools.ietf.org/html/rfc7541#section-4.1} RFC7541§4.1} for - more details. *) - - val encode_header : t -> Faraday.t -> header -> unit - (** [encode_header encoder f header] writes an encoded header to the Faraday - buffer [f]. *) - - val set_capacity : t -> int -> unit - (** [set_capacity encoder capacity] sets [encoder]'s dynamic table size to - maximum size [capacity]. This size is an approximation of the memory - overhead in bytes. - - See {{:https://tools.ietf.org/html/rfc7540#section-6.5.2} RFC7540§6.5.2} - and {{:https://tools.ietf.org/html/rfc7541#section-4.1} RFC7541§4.1} for - more details. *) -end - -module Decoder : sig - type t - - val create : int -> t - (** [create capacity] initializes a decoder with a dynamic table with maximum - size [capacity]. This size is an approximation of the memory usage in - bytes. - - See {{:https://tools.ietf.org/html/rfc7541#section-4.1} RFC7541§4.1} for - more details. *) - - val set_capacity : t -> int -> (unit, error) result - (** [set_capacity decoder capacity] sets [decoder]'s dynamic table size to - maximum size [capacity]. This size is an approximation of the memory - overhead in bytes. - - See {{:https://tools.ietf.org/html/rfc7540#section-6.5.2} RFC7540§6.5.2} - and {{:https://tools.ietf.org/html/rfc7541#section-4.1} RFC7541§4.1} for - more details. *) - - val decode_headers : t -> (header list, error) result Angstrom.t - (** [decode_headers decoder] creates an Angstrom parser that will decode a - header block and return a list of the decoded headers *) -end diff --git a/hpack/src/huffman.ml b/hpack/src/huffman.ml deleted file mode 100644 index e429783d..00000000 --- a/hpack/src/huffman.ml +++ /dev/null @@ -1,122 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -open Types - -let encoded_length s = - let len = String.length s in - let rec loop bits i = - if i < len then - let input = Char.code s.[i] in - let _, len_in_bits = Huffman_table.encode_table.(input) in - loop (bits + len_in_bits) (i + 1) - else - (* From RFC7541§5.2: - * As the Huffman-encoded data doesn't always end at an octet boundary, - * some padding is inserted after it, up to the next octet boundary. *) - (bits + 7) / 8 - in - loop 0 0 - -let drain t bits len = - let rec loop bits len = - if len >= 8 then ( - let len = len - 8 in - Faraday.write_uint8 t (bits lsr len); - let bits = bits land ((1 lsl len) - 1) in - loop bits len) - else - len, bits - in - loop bits len - -let encode t s = - let len = String.length s in - let rec loop i bits n = - if i < len then - let input = Char.code s.[i] in - let code, len_in_bits = Huffman_table.encode_table.(input) in - let n, bits = - if len_in_bits > 24 then - let bits = - (bits lsl (len_in_bits - 24)) lor (code lsr (len_in_bits - 25)) - in - drain t bits (n + len_in_bits - 24) - else - n, bits - in - let n', bits' = - drain t ((bits lsl len_in_bits) lor code) (n + len_in_bits) - in - loop (i + 1) bits' n' - else - n, bits - in - let n, bits = loop 0 0 0 in - if n > 0 then - ignore (drain t ((bits lsl 7) lor 0x7f) (n + 7)) - -let[@inline] add_output buffer c = - if c <> '\000' then - Buffer.add_char buffer c - -let[@inline] exists_in_huffman_table token = token <> -1 - -let decode s = - let len = String.length s in - let buffer = Buffer.create len in - let rec loop id accept i = - if i < len then ( - let input = Char.code s.[i] in - let index = (id lsl 4) + (input lsr 4) in - let id, _, output = Huffman_table.decode_table.(index) in - add_output buffer output; - if exists_in_huffman_table id then ( - let index = (id lsl 4) + (input land 0x0f) in - let id, accept, output = Huffman_table.decode_table.(index) in - add_output buffer output; - if exists_in_huffman_table id then - loop id accept (i + 1) - else - Error Decoding_error) - else - Error Decoding_error) - else if not accept then - Error Decoding_error - else - Ok () - in - match loop 0 true 0 with - | Ok _ -> - Ok (Buffer.contents buffer) - | Error e -> - Error e diff --git a/hpack/src/static_table.ml b/hpack/src/static_table.ml deleted file mode 100644 index 15e3f59c..00000000 --- a/hpack/src/static_table.ml +++ /dev/null @@ -1,382 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -(* (partially) generated by util/gen_static.ml *) - -module TokenIndices = struct - let authority = 0 - - let _method = 1 - - let path = 3 - - let scheme = 5 - - let status = 7 - - let accept_charset = 14 - - let accept_encoding = 15 - - let accept_language = 16 - - let accept_ranges = 17 - - let accept = 18 - - let access_control_allow_origin = 19 - - let age = 20 - - let allow = 21 - - let authorization = 22 - - let cache_control = 23 - - let content_disposition = 24 - - let content_encoding = 25 - - let content_language = 26 - - let content_length = 27 - - let content_location = 28 - - let content_range = 29 - - let content_type = 30 - - let cookie = 31 - - let date = 32 - - let etag = 33 - - let expect = 34 - - let expires = 35 - - let from = 36 - - let host = 37 - - let if_match = 38 - - let if_modified_since = 39 - - let if_none_match = 40 - - let if_range = 41 - - let if_unmodified_since = 42 - - let last_modified = 43 - - let link = 44 - - let location = 45 - - let max_forwards = 46 - - let proxy_authenticate = 47 - - let proxy_authorization = 48 - - let range = 49 - - let referer = 50 - - let refresh = 51 - - let retry_after = 52 - - let server = 53 - - let set_cookie = 54 - - let strict_transport_security = 55 - - let transfer_encoding = 56 - - let user_agent = 57 - - let vary = 58 - - let via = 59 - - let www_authenticate = 60 -end - -let table_size = 61 - -let table = - [| ":authority", "" - ; ":method", "GET" - ; ":method", "POST" - ; ":path", "/" - ; ":path", "/index.html" - ; ":scheme", "http" - ; ":scheme", "https" - ; ":status", "200" - ; ":status", "204" - ; ":status", "206" - ; ":status", "304" - ; ":status", "400" - ; ":status", "404" - ; ":status", "500" - ; "accept-charset", "" - ; "accept-encoding", "gzip, deflate" - ; "accept-language", "" - ; "accept-ranges", "" - ; "accept", "" - ; "access-control-allow-origin", "" - ; "age", "" - ; "allow", "" - ; "authorization", "" - ; "cache-control", "" - ; "content-disposition", "" - ; "content-encoding", "" - ; "content-language", "" - ; "content-length", "" - ; "content-location", "" - ; "content-range", "" - ; "content-type", "" - ; "cookie", "" - ; "date", "" - ; "etag", "" - ; "expect", "" - ; "expires", "" - ; "from", "" - ; "host", "" - ; "if-match", "" - ; "if-modified-since", "" - ; "if-none-match", "" - ; "if-range", "" - ; "if-unmodified-since", "" - ; "last-modified", "" - ; "link", "" - ; "location", "" - ; "max-forwards", "" - ; "proxy-authenticate", "" - ; "proxy-authorization", "" - ; "range", "" - ; "referer", "" - ; "refresh", "" - ; "retry-after", "" - ; "server", "" - ; "set-cookie", "" - ; "strict-transport-security", "" - ; "transfer-encoding", "" - ; "user-agent", "" - ; "vary", "" - ; "via", "" - ; "www-authenticate", "" - |] - -let lookup_token_index name = - match String.length name with - | 3 -> - (match name.[0] with - | 'a' when name = "age" -> - 20 - | 'v' when name = "via" -> - 59 - | _ -> - -1) - | 4 -> - (match name.[0] with - | 'd' when name = "date" -> - 32 - | 'e' when name = "etag" -> - 33 - | 'f' when name = "from" -> - 36 - | 'h' when name = "host" -> - 37 - | 'l' when name = "link" -> - 44 - | 'v' when name = "vary" -> - 58 - | _ -> - -1) - | 5 -> - (match name.[0] with - | ':' when name = ":path" -> - 3 - | 'a' when name = "allow" -> - 21 - | 'r' when name = "range" -> - 49 - | _ -> - -1) - | 6 -> - (match name.[0] with - | 'a' when name = "accept" -> - 18 - | 'c' when name = "cookie" -> - 31 - | 'e' when name = "expect" -> - 34 - | 's' when name = "server" -> - 53 - | _ -> - -1) - | 7 -> - (match name.[3] with - | 't' when name = ":method" -> - 1 - | 'h' when name = ":scheme" -> - 5 - | 'a' when name = ":status" -> - 7 - | 'i' when name = "expires" -> - 35 - | 'e' when name = "referer" -> - 50 - | 'r' when name = "refresh" -> - 51 - | _ -> - -1) - | 8 -> - (match name.[3] with - | 'm' when name = "if-match" -> - 38 - | 'r' when name = "if-range" -> - 41 - | 'a' when name = "location" -> - 45 - | _ -> - -1) - | 10 -> - (match name.[0] with - | ':' when name = ":authority" -> - 0 - | 's' when name = "set-cookie" -> - 54 - | 'u' when name = "user-agent" -> - 57 - | _ -> - -1) - | 11 -> - (match name.[0] with 'r' when name = "retry-after" -> 52 | _ -> -1) - | 12 -> - (match name.[0] with - | 'c' when name = "content-type" -> - 30 - | 'm' when name = "max-forwards" -> - 46 - | _ -> - -1) - | 13 -> - (match name.[6] with - | '-' when name = "accept-ranges" -> - 17 - | 'i' when name = "authorization" -> - 22 - | 'c' when name = "cache-control" -> - 23 - | 't' when name = "content-range" -> - 29 - | 'e' when name = "if-none-match" -> - 40 - | 'o' when name = "last-modified" -> - 43 - | _ -> - -1) - | 14 -> - (match name.[0] with - | 'a' when name = "accept-charset" -> - 14 - | 'c' when name = "content-length" -> - 27 - | _ -> - -1) - | 15 -> - (match name.[7] with - | 'e' when name = "accept-encoding" -> - 15 - | 'l' when name = "accept-language" -> - 16 - | _ -> - -1) - | 16 -> - (match name.[11] with - | 'o' when name = "content-encoding" -> - 25 - | 'g' when name = "content-language" -> - 26 - | 'a' when name = "content-location" -> - 28 - | 'i' when name = "www-authenticate" -> - 60 - | _ -> - -1) - | 17 -> - (match name.[0] with - | 'i' when name = "if-modified-since" -> - 39 - | 't' when name = "transfer-encoding" -> - 56 - | _ -> - -1) - | 18 -> - (match name.[0] with - | 'p' when name = "proxy-authenticate" -> - 47 - | _ -> - -1) - | 19 -> - (match name.[0] with - | 'c' when name = "content-disposition" -> - 24 - | 'i' when name = "if-unmodified-since" -> - 42 - | 'p' when name = "proxy-authorization" -> - 48 - | _ -> - -1) - | 25 -> - (match name.[0] with - | 's' when name = "strict-transport-security" -> - 55 - | _ -> - -1) - | 27 -> - (match name.[0] with - | 'a' when name = "access-control-allow-origin" -> - 19 - | _ -> - -1) - | _ -> - -1 diff --git a/hpack/src/types.ml b/hpack/src/types.ml deleted file mode 100644 index 67fc02fe..00000000 --- a/hpack/src/types.ml +++ /dev/null @@ -1,39 +0,0 @@ -(*---------------------------------------------------------------------------- - * Copyright (c) 2019 António Nuno Monteiro - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its - * contributors may be used to endorse or promote products derived from this - * software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *---------------------------------------------------------------------------*) - -type header = - { name : string - ; value : string - ; sensitive : bool - } - -type error = Decoding_error diff --git a/hpack/test/dune b/hpack/test/dune deleted file mode 100644 index c40289ca..00000000 --- a/hpack/test/dune +++ /dev/null @@ -1,13 +0,0 @@ -(executable - (name test) - (libraries hpack yojson hex alcotest)) - -(include_subdirs unqualified) - -(alias - (name slowtests) - (deps - (:test_exe test.exe) - (source_tree "hpack-test-case/")) - (action - (run %{test_exe}))) diff --git a/hpack/test/hpack-test-case b/hpack/test/hpack-test-case deleted file mode 160000 index b2a1664b..00000000 --- a/hpack/test/hpack-test-case +++ /dev/null @@ -1 +0,0 @@ -Subproject commit b2a1664b43dc520a4bbff2e7db1b7e7af4fb43f4 diff --git a/hpack/test/test.ml b/hpack/test/test.ml deleted file mode 100644 index 055f199f..00000000 --- a/hpack/test/test.ml +++ /dev/null @@ -1,325 +0,0 @@ -open Hpack -module Json = Yojson.Basic.Util - -let parse_file file = - let json = Yojson.Basic.from_file file in - let description = - match Json.(json |> member "description" |> to_string_option) with - | Some x -> - x - | None -> - file - in - let cases = - List.map - (fun case -> - let header_table_size = - match Json.(case |> member "header_table_size" |> to_int_option) with - | Some size -> - size - | None -> - 4096 - in - let wire = - match Json.(case |> member "wire" |> to_string_option) with - | Some hex -> - Hex.to_string (`Hex hex) - | None -> - "" - in - let headers = - List.map - (function - | `Assoc [ (name, `String value) ] -> - { Hpack.name; value; sensitive = false } - | _ -> - assert false) - Json.(case |> member "headers" |> to_list) - in - header_table_size, wire, headers) - Json.(json |> member "cases" |> to_list) - in - description, cases - -let h x = Hex.to_string (`Hex x) - -let hex_of_string s = s |> Hex.of_string |> Hex.show - -let encode_headers encoder headers = - let faraday = Faraday.create 0x1000 in - List.iter (Encoder.encode_header encoder faraday) headers; - Faraday.serialize_to_string faraday - -let encode cases = - let encoder = Hpack.Encoder.create 4096 in - List.mapi - (fun seq (_nosize, _nowire, headers) -> - let wire = encode_headers encoder headers in - seq, hex_of_string wire, headers) - cases - -let encode_file fixtures_dir (story, file) = - let _, cases = parse_file file in - let result = encode cases in - let json = - `Assoc - [ "description", `String "Encoded by h2's HPACK implementation" - ; ( "cases" - , `List - (result - |> List.map @@ fun (seq, wire, headers) -> - `Assoc - [ "seqno", `Int seq - ; "wire", `String wire - ; ( "headers" - , `List - (headers - |> List.map @@ fun { name; value; _ } -> - `Assoc [ name, `String value ]) ) - ]) ) - ] - in - let channel = - open_out Filename.(concat fixtures_dir (concat "ocaml-hpack" story)) - in - Yojson.pretty_to_channel channel json; - close_out channel - -let encode_raw_data fixtures_dir files = - List.iter (encode_file fixtures_dir) files - -let header_equal { name; value; _ } { name = name'; value = value'; _ } = - name = name' && value = value' - -let header_testable = - (module struct - type t = header - - let pp formatter { name; value; _ } = Fmt.pf formatter "%s: %s" name value - - let _pp_with_index formatter { name; value; sensitive } = - Fmt.pf formatter "%s: %s (%B)" name value sensitive - - let equal h1 h2 = header_equal h1 h2 - end : Alcotest.TESTABLE - with type t = header) - -let headers_list_pp = - let (module Headers) = header_testable in - Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_string fmt ";\n") - Headers.pp - -let decode_headers decoder size wire = - let parser = Angstrom.Buffered.parse (Decoder.decode_headers decoder) in - match Decoder.set_capacity decoder size with - | Error _ -> - assert false - | Ok () -> - let state = Angstrom.Buffered.feed parser (`String wire) in - let state' = Angstrom.Buffered.feed state `Eof in - (match Angstrom.Buffered.state_to_option state' with - | Some (Ok headers) -> - List.rev headers - | Some _ | None -> - assert false) - -let decode cases = - let encoder = Encoder.create 4096 in - (* Note: Encoders and decoders are stateful. To check rountripping we need to - use 2 decoders. Here's why: We initially decode the headers we parsed from - JSON and assert that they're the same as the JSON we got. - - We then want to: 1. Encode the resulting headers 2. Decode them again 3. - Check they are indeed the same - - The reason why we need 2 decoders is because of `1.` above. Since - compression / decompression state is stateful, and we don't have access to - the first encoder (which may have state about indexed fields that - `decoder1` has computed in the meantime), using `decoder1` would produce - wrong headers (given wrong expectations about indexed header fields). - - From then on, we can feel free to use the `encoder` / `decoder2` pair, as - that effectively mimics the same "connection". In fact, encoding and - decoding the same headers multiple times will make the compressed payload - smaller. We check that too. *) - let decoder1 = Decoder.create 65536 in - let decoder2 = Decoder.create 65536 in - List.iter - (fun (size, wire, headers) -> - Encoder.set_capacity encoder size; - let decoded_headers = decode_headers decoder1 size wire in - Alcotest.(check int) - "same length" - (List.length headers) - (List.length decoded_headers); - List.iter2 - (fun h1 h2 -> - Alcotest.( - check header_testable "Headers are decoded correctly" h1 h2)) - headers - decoded_headers; - - (* roundtripping *) - let encoded = encode_headers encoder decoded_headers in - let decoded_headers' = decode_headers decoder2 size encoded in - Alcotest.(check int) - "same length" - (List.length headers) - (List.length decoded_headers); - List.iter2 - (fun h1 h2 -> - Alcotest.( - check header_testable "Headers are decoded correctly" h1 h2)) - decoded_headers' - decoded_headers; - - (* Now check that the `encoded_again` payload is smaller than the `encoded` - * payload. Indexing has happened! *) - let enc', dec' = - Array.fold_left - (fun (_, decoded_headers) _ -> - let encoded_again = encode_headers encoder decoded_headers in - let decoded_again = decode_headers decoder2 size encoded_again in - encoded_again, decoded_again) - ("", decoded_headers') - (Array.make 5 0) - in - Alcotest.(check bool) - "encoded_again payload is smaller or equal than encoded" - true - (String.length enc' <= String.length encoded); - - (* And check roundtripping again for good measure. *) - List.iter2 - (fun h1 h2 -> - Alcotest.( - check header_testable "Headers are decoded correctly" h1 h2)) - dec' - headers) - cases - -let rec take_n acc i ys = - match i, ys with - | 0, _ -> - acc - | _, [] -> - acc - | _, x :: xs when i > 0 -> - take_n (x :: acc) (i - 1) xs - | _ -> - acc - -let gen_suites fixtures = - let gen_suite filename = - let test_case_name, fixture = parse_file filename in - test_case_name, `Slow, fun () -> decode fixture - in - List.map - (fun (suite_name, files) -> - let suite = List.map gen_suite files in - suite_name, suite) - fixtures - -let files_in_dir dir = dir |> Sys.readdir |> Array.to_list - -let read_fixtures fixtures_dir = - fixtures_dir - |> files_in_dir - |> List.map (fun dir -> dir, Filename.concat fixtures_dir dir) - (* don't need to decode raw-data, it's already in ocaml-hpack. *) - |> List.filter (fun (dir, fullpath) -> - Sys.is_directory fullpath && dir <> "raw-data") - |> List.map (fun (dir, fullpath) -> - let files_in_dir = - fullpath - |> files_in_dir - |> List.map (fun file -> Filename.concat fullpath file) - |> List.filter (fun file -> - (not (Sys.is_directory file)) - && Filename.extension file = ".json") - in - dir, files_in_dir) - -let test_evicting_table_size_0 () = - let hs = - [ { name = ":method"; value = "GET"; sensitive = false } - ; { name = "field_not_indexed"; value = "foo"; sensitive = false } - ] - in - let encoder = Encoder.create 0 in - let encoded_headers = encode_headers encoder hs in - Alcotest.(check bool) - "Encodes to non-zero hex" - true - (String.length encoded_headers > 0); - - (* From RFC7541§6.3: Dynamic Table Size Update - * A dynamic table size update signals a change to the size of the dynamic - * table. - * A dynamic table size update starts with the '001' 3-bit pattern - * - * Note: we add 0x20 at the beginning of the following wire to signal a - * dynamic table size update of 0 before the remaining headers are - * decoded. *) - let wire = h ("20" ^ hex_of_string encoded_headers) in - let decoder = Decoder.create 4096 in - let decoded_headers = decode_headers decoder 4096 wire in - List.iter2 - (fun h1 h2 -> - Alcotest.(check header_testable "Decoded headers are roundtripped" h1 h2)) - hs - decoded_headers - -let test_evicting_table_size_0_followup () = - let hs = - [ { name = ":method"; value = "GET"; sensitive = false } - ; { name = "field_not_indexed"; value = "foo"; sensitive = false } - ; { name = "yet_another_field_not_indexed" - ; value = "baz" - ; sensitive = false - } - ] - in - let encoder = Encoder.create 60 in - let encoded_headers = encode_headers encoder hs in - Alcotest.(check bool) - "Encodes to non-zero hex" - true - (String.length encoded_headers > 0); - let decoder = Decoder.create 60 in - let decoded_headers = decode_headers decoder 60 encoded_headers in - List.iter2 - (fun h1 h2 -> - Alcotest.(check header_testable "Decoded headers are roundtripped" h1 h2)) - hs - decoded_headers - -let () = - let fixtures_dir = "hpack-test-case" in - let raw_data_dir = Filename.concat fixtures_dir "raw-data" in - let raw_data = - raw_data_dir - |> files_in_dir - |> List.map (fun file -> file, Filename.concat raw_data_dir file) - |> List.sort (fun (file, _) (file2, _) -> compare file file2) - in - (try Unix.mkdir (Filename.concat fixtures_dir "ocaml-hpack") 0o755 with - | Unix.Unix_error (Unix.EEXIST, _, _) -> - ()); - encode_raw_data fixtures_dir raw_data; - - (* Now, test decoding what we just encoded + roundtripping *) - let fixtures = read_fixtures fixtures_dir in - let suites = gen_suites fixtures in - Alcotest.run - "HPACK" - (( "Handcrafted HPACK tests" - , [ ( "Evictions from the dynamic table with 0 capacity" - , `Quick - , test_evicting_table_size_0 ) - ; ( "Evictions from the dynamic table with 0 capacity (followup test)" - , `Quick - , test_evicting_table_size_0_followup ) - ] ) - :: suites) diff --git a/hpack/util/dune b/hpack/util/dune deleted file mode 100644 index 5c82bb65..00000000 --- a/hpack/util/dune +++ /dev/null @@ -1,3 +0,0 @@ -(executables - (names gen_huffman gen_static) - (libraries compiler-libs.common)) diff --git a/hpack/util/gen_huffman.ml b/hpack/util/gen_huffman.ml deleted file mode 100644 index 9bf571b8..00000000 --- a/hpack/util/gen_huffman.ml +++ /dev/null @@ -1,219 +0,0 @@ -(*---------------------------------------------------------------------------- - Copyright (c) 2019 António Nuno Monteiro - - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are met: - - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - - 3. Neither the name of the copyright holder nor the names of its contributors - may be used to endorse or promote products derived from this software without - specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - POSSIBILITY OF SUCH DAMAGE. - ----------------------------------------------------------------------------*) - -open Parsetree -open Ast_helper -open Asttypes - -let let_ name body = - Str.value - Nonrecursive - [ Vb.mk (Pat.var { txt = name; loc = !default_loc }) body ] - -type node = - { mutable id : int - ; mutable accept : bool - ; left : child - ; right : child - ; transitions : (int option * bool * char option) array - } - -and child = - | Node of node - | Symbol of char - | Missing - -let make_node ?(left = Missing) ?(right = Missing) () = - { id = 0 - ; accept = false - ; left - ; right - ; transitions = Array.make 16 (None, false, None) - } - -let rec add_symbol tree symbol = function - | [] -> - Symbol symbol - | false :: bits -> - (match tree with - | Missing -> - Node (make_node ~left:(add_symbol tree symbol bits) ()) - | Node node -> - Node { node with left = add_symbol node.left symbol bits } - | Symbol _ -> - failwith "add_symbol") - | true :: bits -> - (match tree with - | Missing -> - Node (make_node ~right:(add_symbol tree symbol bits) ()) - | Node node -> - Node { node with right = add_symbol node.right symbol bits } - | Symbol _ -> - failwith "add_symbol") - -let rec set_ids tree eos next_id = - match tree with - | Node node -> - node.id <- next_id; - if eos < 8 then node.accept <- true; - next_id + 1 |> set_ids node.left 8 |> set_ids node.right (eos + 1) - | _ -> - next_id - -let rec traverse root transitions failed symbol node remaining i = - let failed, node, symbol = - match node with - | Symbol symbol -> - failed, root, Some symbol - | Node node -> - failed, node, symbol - | Missing -> - true, root, None - in - if remaining = 0 then ( - transitions.(i) <- - (if failed then - None, false, None - else - Some node.id, node.accept, symbol); - i + 1) - else - traverse root transitions failed symbol node.left (remaining - 1) i - |> traverse root transitions failed symbol node.right (remaining - 1) - -let rec make_transitions root = function - | Node node -> - let i = traverse root node.transitions false None (Node node) 4 0 in - assert (i = 16); - make_transitions root node.left; - make_transitions root node.right - | _ -> - () - -let mk_encode_table encode_table = - let items = - Array.fold_left - (fun acc (code, length) -> - let tup = - Exp.tuple - [ Exp.constant (Pconst_integer (string_of_int code, None)) - ; Exp.constant (Pconst_integer (string_of_int length, None)) - ] - in - tup :: acc) - [] - encode_table - in - let_ "encode_table" (Exp.array (List.rev items)) - -let output_transition (id, accept, symbol) = - let output_int = function - | Some i -> - Exp.constant (Pconst_integer (string_of_int i, None)) - | None -> - Exp.constant (Pconst_integer ("-1", None)) - in - let output_bool b = - Exp.construct - { txt = Longident.Lident (if b then "true" else "false") - ; loc = !default_loc - } - None - in - let output_char = function - | Some c -> - Exp.constant (Pconst_char c) - | None -> - Exp.constant (Pconst_char '\000') - in - Exp.tuple [ output_int id; output_bool accept; output_char symbol ] - -let mk_decode_table tree = - let rec loop tree (i, acc) = - match tree with - | Node node -> - assert (node.id = i); - let acc' = - Array.fold_left - (fun acc transition -> output_transition transition :: acc) - acc - node.transitions - in - (i + 1, acc') |> loop node.left |> loop node.right - | _ -> - i, acc - in - let i, items = loop tree (0, []) in - assert (i = 256); - let_ "decode_table" (Exp.array (List.rev items)) - -let bits_of_string s = - let rec aux i = - if i < String.length s then - match s.[i] with - | '|' -> - aux (i + 1) - | '0' -> - false :: aux (i + 1) - | '1' -> - true :: aux (i + 1) - | _ -> - failwith "bits_of_string" - else - [] - in - aux 0 - -let () = - let ic = Scanf.Scanning.from_file Sys.argv.(1) in - let encode_table = Array.make 256 (0, 0) in - let rec loop tree i = - if i < 256 then ( - Scanf.bscanf ic "%_c%_c%_c ( %d ) %s %x [ %d ]\n" - @@ fun _i s code length -> - assert (i = _i); - encode_table.(i) <- (code, length); - let tree = add_symbol tree (char_of_int i) (bits_of_string s) in - loop tree (i + 1)) - else - let ids = set_ids tree 0 0 in - assert (ids = 256); - tree - in - let tree = loop Missing 0 in - let root = - match tree with Node node -> node | _ -> failwith "empty tree" - in - make_transitions root tree; - let ppf = Format.std_formatter in - Format.fprintf ppf "(* generated by util/gen_huffman.ml *)\n\n"; - Pprintast.structure ppf [ mk_encode_table encode_table; mk_decode_table tree ] diff --git a/hpack/util/gen_static.ml b/hpack/util/gen_static.ml deleted file mode 100644 index a5cc7686..00000000 --- a/hpack/util/gen_static.ml +++ /dev/null @@ -1,224 +0,0 @@ -(*---------------------------------------------------------------------------- - Copyright (c) 2019 António Nuno Monteiro - - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are met: - - 1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - - 3. Neither the name of the copyright holder nor the names of its contributors - may be used to endorse or promote products derived from this software without - specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - POSSIBILITY OF SUCH DAMAGE. - ----------------------------------------------------------------------------*) - -open Parsetree -open Ast_helper -open Asttypes - -let let_ name body = - Str.value - Nonrecursive - [ Vb.mk (Pat.var { txt = name; loc = !default_loc }) body ] - -module CharSet = Set.Make (Char) - -module Hashtbl = struct - include Hashtbl - - let[@inline] find_opt h key = try Some (find h key) with Not_found -> None -end - -let token_of_name = - String.map @@ function ('a' .. 'z' | 'A' .. 'Z') as c -> c | _ -> '_' - -let mk_tokens static_table = - let _, tokens = - Array.fold_left - (fun (prev_token, acc) (i, name, _) -> - if name <> prev_token then - let token = - let_ - (Printf.sprintf "token_%s" (token_of_name name)) - (Exp.constant (Pconst_integer (string_of_int i, None))) - in - name, token :: acc - else - name, acc) - ("", []) - static_table - in - List.rev tokens - -let add_name name i names = - let new_val = - match Hashtbl.find_opt names name with Some i' -> min i i' | None -> i - in - Hashtbl.replace names name new_val - -let find_pos names = - let n = Hashtbl.length names in - let names = Hashtbl.fold (fun k _ lst -> k :: lst) names [] in - let rec loop pos = - if - List.map (fun name -> name.[pos]) names - |> CharSet.of_list - |> CharSet.cardinal - |> ( = ) n - then - pos - else - loop (pos + 1) - in - loop 0 - -let make_token_map static_table = - let tbl = Hashtbl.create 60 in - Array.iter - (fun (i, name, _) -> - let length = String.length name in - let string_tbl = - match Hashtbl.find_opt tbl length with - | Some string_tbl -> - string_tbl - | None -> - Hashtbl.create 10 - in - Hashtbl.add string_tbl name i) - static_table; - Hashtbl.fold - (fun length names ret -> - let bindings = Hashtbl.fold (fun k v lst -> (k, v) :: lst) names [] in - (length, find_pos names, bindings) :: ret) - tbl - [] - -let mk_static_table static_table = - let items = - Array.fold_left - (fun acc (_, name, value) -> - let tup = - Exp.tuple - [ Exp.constant (Pconst_string (name, None)) - ; Exp.constant (Pconst_string (value, None)) - ] - in - tup :: acc) - [] - static_table - in - let_ "table" (Exp.array (List.rev items)) - -let mk_lookup_token token_map = - let_ - "lookup_token" - (Exp.fun_ - Nolabel - None - (Pat.var { txt = "name"; loc = !default_loc }) - (Exp.match_ - (Exp.apply - (Exp.ident - { txt = Longident.(Ldot (Lident "String", "length")) - ; loc = !default_loc - }) - [ ( Nolabel - , Exp.ident - { txt = Longident.Lident "name"; loc = !default_loc } ) - ]) - (List.concat - [ List.map - (fun (length, pos, names) -> - Exp.case - (Pat.constant - (Pconst_integer (string_of_int length, None))) - (Exp.match_ - (Exp.apply - (Exp.ident - { txt = Ldot (Lident "String", "get") - ; loc = !default_loc - }) - [ ( Nolabel - , Exp.ident - { txt = Lident "name"; loc = !default_loc } ) - ; ( Nolabel - , Exp.constant - (Pconst_integer (string_of_int pos, None)) ) - ]) - (List.concat - [ List.map - (fun (name, i) -> - Exp.case - (Pat.constant (Pconst_char name.[pos])) - ~guard: - (Exp.apply - (Exp.ident - { txt = Lident "=" - ; loc = !default_loc - }) - [ ( Nolabel - , Exp.ident - { txt = Lident "name" - ; loc = !default_loc - } ) - ; ( Nolabel - , Exp.constant - (Pconst_string (name, None)) ) - ]) - (Exp.constant - (Pconst_integer (string_of_int i, None)))) - names - ; [ Exp.case - (Pat.any ()) - (Exp.constant (Pconst_integer ("-1", None))) - ] - ]))) - token_map - ; [ Exp.case - (Pat.any ()) - (Exp.constant (Pconst_integer ("-1", None))) - ] - ]))) - -let () = - let ic = open_in Sys.argv.(1) in - let static_table = - Array.init 61 @@ fun i -> - let line = input_line ic in - match String.split_on_char '\t' line with - | [ s; name ] when int_of_string s == i + 1 -> - i, name, "" - | [ s; name; value ] when int_of_string s == i + 1 -> - i, name, value - | _ -> - assert false - in - let token_map = make_token_map static_table in - let ppf = Format.std_formatter in - Format.fprintf ppf "(* generated by util/gen_static.ml *)\n\n"; - let size = let_ "size" (Exp.constant (Pconst_integer ("61", None))) in - Pprintast.structure - ppf - (List.concat - [ size :: mk_tokens static_table - ; [ mk_static_table static_table ] - ; [ mk_lookup_token token_map ] - ]) diff --git a/hpack/util/huffman_table.txt b/hpack/util/huffman_table.txt deleted file mode 100644 index 05218ebf..00000000 --- a/hpack/util/huffman_table.txt +++ /dev/null @@ -1,257 +0,0 @@ - ( 0) |11111111|11000 1ff8 [13] - ( 1) |11111111|11111111|1011000 7fffd8 [23] - ( 2) |11111111|11111111|11111110|0010 fffffe2 [28] - ( 3) |11111111|11111111|11111110|0011 fffffe3 [28] - ( 4) |11111111|11111111|11111110|0100 fffffe4 [28] - ( 5) |11111111|11111111|11111110|0101 fffffe5 [28] - ( 6) |11111111|11111111|11111110|0110 fffffe6 [28] - ( 7) |11111111|11111111|11111110|0111 fffffe7 [28] - ( 8) |11111111|11111111|11111110|1000 fffffe8 [28] - ( 9) |11111111|11111111|11101010 ffffea [24] - ( 10) |11111111|11111111|11111111|111100 3ffffffc [30] - ( 11) |11111111|11111111|11111110|1001 fffffe9 [28] - ( 12) |11111111|11111111|11111110|1010 fffffea [28] - ( 13) |11111111|11111111|11111111|111101 3ffffffd [30] - ( 14) |11111111|11111111|11111110|1011 fffffeb [28] - ( 15) |11111111|11111111|11111110|1100 fffffec [28] - ( 16) |11111111|11111111|11111110|1101 fffffed [28] - ( 17) |11111111|11111111|11111110|1110 fffffee [28] - ( 18) |11111111|11111111|11111110|1111 fffffef [28] - ( 19) |11111111|11111111|11111111|0000 ffffff0 [28] - ( 20) |11111111|11111111|11111111|0001 ffffff1 [28] - ( 21) |11111111|11111111|11111111|0010 ffffff2 [28] - ( 22) |11111111|11111111|11111111|111110 3ffffffe [30] - ( 23) |11111111|11111111|11111111|0011 ffffff3 [28] - ( 24) |11111111|11111111|11111111|0100 ffffff4 [28] - ( 25) |11111111|11111111|11111111|0101 ffffff5 [28] - ( 26) |11111111|11111111|11111111|0110 ffffff6 [28] - ( 27) |11111111|11111111|11111111|0111 ffffff7 [28] - ( 28) |11111111|11111111|11111111|1000 ffffff8 [28] - ( 29) |11111111|11111111|11111111|1001 ffffff9 [28] - ( 30) |11111111|11111111|11111111|1010 ffffffa [28] - ( 31) |11111111|11111111|11111111|1011 ffffffb [28] -' ' ( 32) |010100 14 [ 6] -'!' ( 33) |11111110|00 3f8 [10] -'"' ( 34) |11111110|01 3f9 [10] -'#' ( 35) |11111111|1010 ffa [12] -'$' ( 36) |11111111|11001 1ff9 [13] -'%' ( 37) |010101 15 [ 6] -'&' ( 38) |11111000 f8 [ 8] -''' ( 39) |11111111|010 7fa [11] -'(' ( 40) |11111110|10 3fa [10] -')' ( 41) |11111110|11 3fb [10] -'*' ( 42) |11111001 f9 [ 8] -'+' ( 43) |11111111|011 7fb [11] -',' ( 44) |11111010 fa [ 8] -'-' ( 45) |010110 16 [ 6] -'.' ( 46) |010111 17 [ 6] -'/' ( 47) |011000 18 [ 6] -'0' ( 48) |00000 0 [ 5] -'1' ( 49) |00001 1 [ 5] -'2' ( 50) |00010 2 [ 5] -'3' ( 51) |011001 19 [ 6] -'4' ( 52) |011010 1a [ 6] -'5' ( 53) |011011 1b [ 6] -'6' ( 54) |011100 1c [ 6] -'7' ( 55) |011101 1d [ 6] -'8' ( 56) |011110 1e [ 6] -'9' ( 57) |011111 1f [ 6] -':' ( 58) |1011100 5c [ 7] -';' ( 59) |11111011 fb [ 8] -'<' ( 60) |11111111|1111100 7ffc [15] -'=' ( 61) |100000 20 [ 6] -'>' ( 62) |11111111|1011 ffb [12] -'?' ( 63) |11111111|00 3fc [10] -'@' ( 64) |11111111|11010 1ffa [13] -'A' ( 65) |100001 21 [ 6] -'B' ( 66) |1011101 5d [ 7] -'C' ( 67) |1011110 5e [ 7] -'D' ( 68) |1011111 5f [ 7] -'E' ( 69) |1100000 60 [ 7] -'F' ( 70) |1100001 61 [ 7] -'G' ( 71) |1100010 62 [ 7] -'H' ( 72) |1100011 63 [ 7] -'I' ( 73) |1100100 64 [ 7] -'J' ( 74) |1100101 65 [ 7] -'K' ( 75) |1100110 66 [ 7] -'L' ( 76) |1100111 67 [ 7] -'M' ( 77) |1101000 68 [ 7] -'N' ( 78) |1101001 69 [ 7] -'O' ( 79) |1101010 6a [ 7] -'P' ( 80) |1101011 6b [ 7] -'Q' ( 81) |1101100 6c [ 7] -'R' ( 82) |1101101 6d [ 7] -'S' ( 83) |1101110 6e [ 7] -'T' ( 84) |1101111 6f [ 7] -'U' ( 85) |1110000 70 [ 7] -'V' ( 86) |1110001 71 [ 7] -'W' ( 87) |1110010 72 [ 7] -'X' ( 88) |11111100 fc [ 8] -'Y' ( 89) |1110011 73 [ 7] -'Z' ( 90) |11111101 fd [ 8] -'[' ( 91) |11111111|11011 1ffb [13] -'\' ( 92) |11111111|11111110|000 7fff0 [19] -']' ( 93) |11111111|11100 1ffc [13] -'^' ( 94) |11111111|111100 3ffc [14] -'_' ( 95) |100010 22 [ 6] -'`' ( 96) |11111111|1111101 7ffd [15] -'a' ( 97) |00011 3 [ 5] -'b' ( 98) |100011 23 [ 6] -'c' ( 99) |00100 4 [ 5] -'d' (100) |100100 24 [ 6] -'e' (101) |00101 5 [ 5] -'f' (102) |100101 25 [ 6] -'g' (103) |100110 26 [ 6] -'h' (104) |100111 27 [ 6] -'i' (105) |00110 6 [ 5] -'j' (106) |1110100 74 [ 7] -'k' (107) |1110101 75 [ 7] -'l' (108) |101000 28 [ 6] -'m' (109) |101001 29 [ 6] -'n' (110) |101010 2a [ 6] -'o' (111) |00111 7 [ 5] -'p' (112) |101011 2b [ 6] -'q' (113) |1110110 76 [ 7] -'r' (114) |101100 2c [ 6] -'s' (115) |01000 8 [ 5] -'t' (116) |01001 9 [ 5] -'u' (117) |101101 2d [ 6] -'v' (118) |1110111 77 [ 7] -'w' (119) |1111000 78 [ 7] -'x' (120) |1111001 79 [ 7] -'y' (121) |1111010 7a [ 7] -'z' (122) |1111011 7b [ 7] -'{' (123) |11111111|1111110 7ffe [15] -'|' (124) |11111111|100 7fc [11] -'}' (125) |11111111|111101 3ffd [14] -'~' (126) |11111111|11101 1ffd [13] - (127) |11111111|11111111|11111111|1100 ffffffc [28] - (128) |11111111|11111110|0110 fffe6 [20] - (129) |11111111|11111111|010010 3fffd2 [22] - (130) |11111111|11111110|0111 fffe7 [20] - (131) |11111111|11111110|1000 fffe8 [20] - (132) |11111111|11111111|010011 3fffd3 [22] - (133) |11111111|11111111|010100 3fffd4 [22] - (134) |11111111|11111111|010101 3fffd5 [22] - (135) |11111111|11111111|1011001 7fffd9 [23] - (136) |11111111|11111111|010110 3fffd6 [22] - (137) |11111111|11111111|1011010 7fffda [23] - (138) |11111111|11111111|1011011 7fffdb [23] - (139) |11111111|11111111|1011100 7fffdc [23] - (140) |11111111|11111111|1011101 7fffdd [23] - (141) |11111111|11111111|1011110 7fffde [23] - (142) |11111111|11111111|11101011 ffffeb [24] - (143) |11111111|11111111|1011111 7fffdf [23] - (144) |11111111|11111111|11101100 ffffec [24] - (145) |11111111|11111111|11101101 ffffed [24] - (146) |11111111|11111111|010111 3fffd7 [22] - (147) |11111111|11111111|1100000 7fffe0 [23] - (148) |11111111|11111111|11101110 ffffee [24] - (149) |11111111|11111111|1100001 7fffe1 [23] - (150) |11111111|11111111|1100010 7fffe2 [23] - (151) |11111111|11111111|1100011 7fffe3 [23] - (152) |11111111|11111111|1100100 7fffe4 [23] - (153) |11111111|11111110|11100 1fffdc [21] - (154) |11111111|11111111|011000 3fffd8 [22] - (155) |11111111|11111111|1100101 7fffe5 [23] - (156) |11111111|11111111|011001 3fffd9 [22] - (157) |11111111|11111111|1100110 7fffe6 [23] - (158) |11111111|11111111|1100111 7fffe7 [23] - (159) |11111111|11111111|11101111 ffffef [24] - (160) |11111111|11111111|011010 3fffda [22] - (161) |11111111|11111110|11101 1fffdd [21] - (162) |11111111|11111110|1001 fffe9 [20] - (163) |11111111|11111111|011011 3fffdb [22] - (164) |11111111|11111111|011100 3fffdc [22] - (165) |11111111|11111111|1101000 7fffe8 [23] - (166) |11111111|11111111|1101001 7fffe9 [23] - (167) |11111111|11111110|11110 1fffde [21] - (168) |11111111|11111111|1101010 7fffea [23] - (169) |11111111|11111111|011101 3fffdd [22] - (170) |11111111|11111111|011110 3fffde [22] - (171) |11111111|11111111|11110000 fffff0 [24] - (172) |11111111|11111110|11111 1fffdf [21] - (173) |11111111|11111111|011111 3fffdf [22] - (174) |11111111|11111111|1101011 7fffeb [23] - (175) |11111111|11111111|1101100 7fffec [23] - (176) |11111111|11111111|00000 1fffe0 [21] - (177) |11111111|11111111|00001 1fffe1 [21] - (178) |11111111|11111111|100000 3fffe0 [22] - (179) |11111111|11111111|00010 1fffe2 [21] - (180) |11111111|11111111|1101101 7fffed [23] - (181) |11111111|11111111|100001 3fffe1 [22] - (182) |11111111|11111111|1101110 7fffee [23] - (183) |11111111|11111111|1101111 7fffef [23] - (184) |11111111|11111110|1010 fffea [20] - (185) |11111111|11111111|100010 3fffe2 [22] - (186) |11111111|11111111|100011 3fffe3 [22] - (187) |11111111|11111111|100100 3fffe4 [22] - (188) |11111111|11111111|1110000 7ffff0 [23] - (189) |11111111|11111111|100101 3fffe5 [22] - (190) |11111111|11111111|100110 3fffe6 [22] - (191) |11111111|11111111|1110001 7ffff1 [23] - (192) |11111111|11111111|11111000|00 3ffffe0 [26] - (193) |11111111|11111111|11111000|01 3ffffe1 [26] - (194) |11111111|11111110|1011 fffeb [20] - (195) |11111111|11111110|001 7fff1 [19] - (196) |11111111|11111111|100111 3fffe7 [22] - (197) |11111111|11111111|1110010 7ffff2 [23] - (198) |11111111|11111111|101000 3fffe8 [22] - (199) |11111111|11111111|11110110|0 1ffffec [25] - (200) |11111111|11111111|11111000|10 3ffffe2 [26] - (201) |11111111|11111111|11111000|11 3ffffe3 [26] - (202) |11111111|11111111|11111001|00 3ffffe4 [26] - (203) |11111111|11111111|11111011|110 7ffffde [27] - (204) |11111111|11111111|11111011|111 7ffffdf [27] - (205) |11111111|11111111|11111001|01 3ffffe5 [26] - (206) |11111111|11111111|11110001 fffff1 [24] - (207) |11111111|11111111|11110110|1 1ffffed [25] - (208) |11111111|11111110|010 7fff2 [19] - (209) |11111111|11111111|00011 1fffe3 [21] - (210) |11111111|11111111|11111001|10 3ffffe6 [26] - (211) |11111111|11111111|11111100|000 7ffffe0 [27] - (212) |11111111|11111111|11111100|001 7ffffe1 [27] - (213) |11111111|11111111|11111001|11 3ffffe7 [26] - (214) |11111111|11111111|11111100|010 7ffffe2 [27] - (215) |11111111|11111111|11110010 fffff2 [24] - (216) |11111111|11111111|00100 1fffe4 [21] - (217) |11111111|11111111|00101 1fffe5 [21] - (218) |11111111|11111111|11111010|00 3ffffe8 [26] - (219) |11111111|11111111|11111010|01 3ffffe9 [26] - (220) |11111111|11111111|11111111|1101 ffffffd [28] - (221) |11111111|11111111|11111100|011 7ffffe3 [27] - (222) |11111111|11111111|11111100|100 7ffffe4 [27] - (223) |11111111|11111111|11111100|101 7ffffe5 [27] - (224) |11111111|11111110|1100 fffec [20] - (225) |11111111|11111111|11110011 fffff3 [24] - (226) |11111111|11111110|1101 fffed [20] - (227) |11111111|11111111|00110 1fffe6 [21] - (228) |11111111|11111111|101001 3fffe9 [22] - (229) |11111111|11111111|00111 1fffe7 [21] - (230) |11111111|11111111|01000 1fffe8 [21] - (231) |11111111|11111111|1110011 7ffff3 [23] - (232) |11111111|11111111|101010 3fffea [22] - (233) |11111111|11111111|101011 3fffeb [22] - (234) |11111111|11111111|11110111|0 1ffffee [25] - (235) |11111111|11111111|11110111|1 1ffffef [25] - (236) |11111111|11111111|11110100 fffff4 [24] - (237) |11111111|11111111|11110101 fffff5 [24] - (238) |11111111|11111111|11111010|10 3ffffea [26] - (239) |11111111|11111111|1110100 7ffff4 [23] - (240) |11111111|11111111|11111010|11 3ffffeb [26] - (241) |11111111|11111111|11111100|110 7ffffe6 [27] - (242) |11111111|11111111|11111011|00 3ffffec [26] - (243) |11111111|11111111|11111011|01 3ffffed [26] - (244) |11111111|11111111|11111100|111 7ffffe7 [27] - (245) |11111111|11111111|11111101|000 7ffffe8 [27] - (246) |11111111|11111111|11111101|001 7ffffe9 [27] - (247) |11111111|11111111|11111101|010 7ffffea [27] - (248) |11111111|11111111|11111101|011 7ffffeb [27] - (249) |11111111|11111111|11111111|1110 ffffffe [28] - (250) |11111111|11111111|11111101|100 7ffffec [27] - (251) |11111111|11111111|11111101|101 7ffffed [27] - (252) |11111111|11111111|11111101|110 7ffffee [27] - (253) |11111111|11111111|11111101|111 7ffffef [27] - (254) |11111111|11111111|11111110|000 7fffff0 [27] - (255) |11111111|11111111|11111011|10 3ffffee [26] -EOS (256) |11111111|11111111|11111111|111111 3fffffff [30] diff --git a/hpack/util/static_table.txt b/hpack/util/static_table.txt deleted file mode 100644 index 2817b894..00000000 --- a/hpack/util/static_table.txt +++ /dev/null @@ -1,61 +0,0 @@ -1 :authority -2 :method GET -3 :method POST -4 :path / -5 :path /index.html -6 :scheme http -7 :scheme https -8 :status 200 -9 :status 204 -10 :status 206 -11 :status 304 -12 :status 400 -13 :status 404 -14 :status 500 -15 accept-charset -16 accept-encoding gzip, deflate -17 accept-language -18 accept-ranges -19 accept -20 access-control-allow-origin -21 age -22 allow -23 authorization -24 cache-control -25 content-disposition -26 content-encoding -27 content-language -28 content-length -29 content-location -30 content-range -31 content-type -32 cookie -33 date -34 etag -35 expect -36 expires -37 from -38 host -39 if-match -40 if-modified-since -41 if-none-match -42 if-range -43 if-unmodified-since -44 last-modified -45 link -46 location -47 max-forwards -48 proxy-authenticate -49 proxy-authorization -50 range -51 referer -52 refresh -53 retry-after -54 server -55 set-cookie -56 strict-transport-security -57 transfer-encoding -58 user-agent -59 vary -60 via -61 www-authenticate diff --git a/hpack/util/syntax.ml b/hpack/util/syntax.ml deleted file mode 100644 index afee1d2f..00000000 --- a/hpack/util/syntax.ml +++ /dev/null @@ -1,5 +0,0 @@ -open Parsetree -open Ast_helper -open Asttypes - -let strloc txt = { txt; loc = !default_loc } From 74a2ad6e276bc69df323ab75b564c2851457767b Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Mon, 1 Jul 2019 14:54:17 +0200 Subject: [PATCH 2/7] Use new hpack library --- lib/client_connection.ml | 16 +++++++++------- lib/config.ml | 4 ++++ lib/h2.mli | 18 ++++++++++-------- lib/headers.ml | 18 +++++++++--------- lib/serialize.ml | 14 ++++---------- lib/server_connection.ml | 16 +++++++++------- lib/settings.ml | 6 ++++++ lib/stream.ml | 2 +- lib_test/test_h2_client.ml | 14 +++++++------- lib_test/test_h2_server.ml | 12 ++++++------ 10 files changed, 65 insertions(+), 55 deletions(-) diff --git a/lib/client_connection.ml b/lib/client_connection.ml index ce5cc4fb..c75df456 100644 --- a/lib/client_connection.ml +++ b/lib/client_connection.ml @@ -402,7 +402,7 @@ let handle_headers_block t.receiving_headers_for_stream <- None; let parse_state' = AB.feed parse_state' `Eof in match parse_state' with - | Done (_, Ok headers) -> + | Done (_, headers) -> if not is_trailers then (* `handle_headers` will take care of transitioning the stream state *) let end_stream = partial_headers.end_stream in @@ -425,7 +425,7 @@ let handle_headers_block (* From RFC7540§4.3: * A decoding error in a header block MUST be treated as a connection * error (Section 5.4.1) of type COMPRESSION_ERROR. *) - | Done (_, Error _) | Partial _ -> + | Partial _ -> report_connection_error t Error.CompressionError | Fail (_, _, message) -> report_connection_error @@ -451,7 +451,7 @@ let create_partial_headers t flags headers_block = { Stream.parse_state = AB.parse ~initial_buffer_size - (Hpack.Decoder.decode_headers t.hpack_decoder) + (Hpack.Decoder.headers t.hpack_decoder) ; end_stream = Flags.test_end_stream flags } @@ -493,7 +493,7 @@ let process_trailer_headers t respd active_response frame_header headers_block = else let partial_headers = { Stream.parse_state = - AB.parse (Hpack.Decoder.decode_headers t.hpack_decoder) + AB.parse (Hpack.Decoder.headers t.hpack_decoder) (* obviously true at this point. *) ; end_stream } @@ -846,7 +846,8 @@ let process_settings_frame t { Frame.frame_header; _ } settings = * size of the header compression table used to decode header * blocks, in octets. *) t.settings.header_table_size <- x; - Hpack.Encoder.set_capacity t.hpack_encoder x + let table_size = min t.config.encoder_table_size x in + Hpack.Encoder.change_table_size t.hpack_encoder table_size | EnablePush, x -> (* We've already verified that this setting is either 0 or 1 in the * call to `Settings.check_settings_list` above. *) @@ -1164,6 +1165,7 @@ let create ?(config = Config.default) ?push_handler ~error_handler = (* If the caller is not going to process PUSH_PROMISE frames, just * disable it. *) config.enable_server_push && push_handler != default_push_handler + ; header_table_size = config.decoder_table_size } in let rec connection_preface_handler recv_frame settings_list = @@ -1243,8 +1245,8 @@ let create ?(config = Config.default) ?push_handler ~error_handler = (* From RFC7540§4.3: * Header compression is stateful. One compression context and one * decompression context are used for the entire connection. *) - ; hpack_encoder = Hpack.Encoder.(create settings.header_table_size) - ; hpack_decoder = Hpack.Decoder.(create settings.header_table_size) + ; hpack_encoder = Hpack.Encoder.create ~max_size:(min Settings.default_settings.header_table_size config.encoder_table_size) () + ; hpack_decoder = Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () } in let t = Lazy.force t in diff --git a/lib/config.ml b/lib/config.ml index 4135d21f..243e37f3 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -39,6 +39,8 @@ type t = ; enable_server_push : bool ; max_concurrent_streams : int ; initial_window_size : int + ; encoder_table_size : int + ; decoder_table_size : int } let default = @@ -71,4 +73,6 @@ let default = * Indicates the sender's initial window size (in octets) for * stream-level flow control. *) ; initial_window_size = Settings.WindowSize.default_initial_window_size + ; encoder_table_size = 0x1000 + ; decoder_table_size = 0x1000 } diff --git a/lib/h2.mli b/lib/h2.mli index a998bd9a..1348c947 100644 --- a/lib/h2.mli +++ b/lib/h2.mli @@ -268,10 +268,10 @@ module Headers : sig (** [to_rev_list t] is the association list of header fields contained in [t] in {i reverse} transmission order. *) - val add : t -> ?sensitive:bool -> name -> value -> t - (** [add t ?sensitive name value] is a collection of header fields that is + val add : t -> ?never_index:bool -> name -> value -> t + (** [add t ?never_index name value] is a collection of header fields that is the same as [t] except with [(name, value)] added at the end of the - trasmission order. Additionally, [sensitive] specifies whether this + trasmission order. Additionally, [never_index] specifies whether this header field should not be compressed by HPACK and instead encoded as a never-indexed literal (see {{:https://tools.ietf.org/html/rfc7541#section-7.1.3} RFC7541§7.1.3} for @@ -281,10 +281,10 @@ module Headers : sig - [get (add t name value) name = Some value] *) - val add_unless_exists : t -> ?sensitive:bool -> name -> value -> t - (** [add_unless_exists t ?sensitive name value] is a collection of header + val add_unless_exists : t -> ?never_index:bool -> name -> value -> t + (** [add_unless_exists t ?never_index name value] is a collection of header fields that is the same as [t] if [t] already inclues [name], and - otherwise is equivalent to [add t ?sensitive name value]. *) + otherwise is equivalent to [add t ?never_index name value]. *) val add_list : t -> (name * value) list -> t (** [add_list t assoc] is a collection of header fields that is the same as @@ -312,8 +312,8 @@ add_multi t ["name1", ["x", "y"]; "name2", ["p", "q"]] = add_list equal to [name]. If [t] contains multiple header fields whose name is [name], they will all be removed. *) - val replace : t -> ?sensitive:bool -> name -> value -> t - (** [replace t ?sensitive name value] is a collection of header fields that + val replace : t -> ?never_index:bool -> name -> value -> t + (** [replace t ?never_index name value] is a collection of header fields that is the same as [t] except with all header fields with a name equal to [name] removed and replaced with a single header field whose name is [name] and whose value is [value]. This new header field will appear in @@ -588,6 +588,8 @@ module Config : sig ; initial_window_size : int (** [initial_window_size] specifies the initial window size for flow control tokens. Defaults to [65535] *) + ; encoder_table_size : int (** Defaults to [4096] *) + ; decoder_table_size : int (** Defaults to [4096] *) } val default : t diff --git a/lib/headers.ml b/lib/headers.ml index cf33fd9c..c01da1cd 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -36,10 +36,10 @@ type name = string type value = string -type header = Hpack.header = +type header = Hpack.Header.t = private { name : name ; value : value - ; sensitive : bool + ; never_index : bool } type t = header list @@ -47,7 +47,7 @@ type t = header list let empty : t = [] let of_rev_list hs = - List.map (fun (name, value) -> { name; value; sensitive = false }) hs + List.map (fun (name, value) -> Hpack.Header.make name value) hs let of_list t = of_rev_list (List.rev t) @@ -108,7 +108,7 @@ let rec mem t name = false (* TODO: do we need to keep a list of never indexed fields? *) -let add t ?(sensitive = false) name value = { name; value; sensitive } :: t +let add t ?(never_index = false) name value = Hpack.Header.make ~never_index name value :: t let add_list t ls = of_rev_list ls @ t (* XXX(seliopou): do better here *) @@ -120,17 +120,17 @@ let add_multi = | [] -> loop_outer t lss | v :: vs' -> - loop_inner ({ name = n; value = v; sensitive = false } :: t) n vs' lss + loop_inner (Hpack.Header.make n v :: t) n vs' lss in loop_outer -let add_unless_exists t ?(sensitive = false) name value = +let add_unless_exists t ?(never_index = false) name value = if mem t name then t else - { name; value; sensitive } :: t + Hpack.Header.make ~never_index name value :: t -let replace t ?(sensitive = false) name value = +let replace t ?(never_index = false) name value = let rec loop t n nv seen = match t with | [] -> @@ -144,7 +144,7 @@ let replace t ?(sensitive = false) name value = else nv' :: loop t n nv false in - try loop t name { name; value; sensitive } false with Local -> t + try loop t name (Hpack.Header.make ~never_index name value) false with Local -> t let remove t name = let rec loop s n seen = diff --git a/lib/serialize.ml b/lib/serialize.ml index dfd42de0..2fe12206 100644 --- a/lib/serialize.ml +++ b/lib/serialize.ml @@ -481,21 +481,18 @@ module Writer = struct Hpack.Encoder.encode_header hpack_encoder faraday - { Headers.name = ":method" - ; value = Httpaf.Method.to_string meth - ; sensitive = false - }; + (Hpack.Header.make ":method" (Httpaf.Method.to_string meth)); if meth <> `CONNECT then ( (* From RFC7540§8.3: * The :scheme and :path pseudo-header fields MUST be omitted. *) Hpack.Encoder.encode_header hpack_encoder faraday - { Headers.name = ":path"; value = target; sensitive = false }; + (Hpack.Header.make ":path" target); Hpack.Encoder.encode_header hpack_encoder faraday - { Headers.name = ":scheme"; value = scheme; sensitive = false }); + (Hpack.Header.make ":scheme" scheme)); encode_headers hpack_encoder faraday headers; chunk_header_block_fragments t frame_info ~write_frame faraday @@ -518,10 +515,7 @@ module Writer = struct Hpack.Encoder.encode_header hpack_encoder faraday - { Headers.name = ":status" - ; value = Status.to_string status - ; sensitive = false - }; + (Hpack.Header.make ":status" (Status.to_string status)); encode_headers hpack_encoder faraday headers; let has_priority = match priority with Some _ -> true | None -> false in chunk_header_block_fragments diff --git a/lib/server_connection.ml b/lib/server_connection.ml index 10ec6c8d..84073fb4 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -328,7 +328,7 @@ let handle_headers_block t.receiving_headers_for_stream <- None; let parse_state' = AB.feed parse_state' `Eof in match parse_state' with - | Done (_, Ok headers) -> + | Done (_, headers) -> if not is_trailers then ( (* Note: * the highest stream identifier that the server has seen is set here @@ -364,7 +364,7 @@ let handle_headers_block (* From RFC7540§4.3: * A decoding error in a header block MUST be treated as a connection * error (Section 5.4.1) of type COMPRESSION_ERROR. *) - | Done (_, Error _) | Partial _ -> + | Partial _ -> report_connection_error t Error.CompressionError | Fail (_, _, message) -> report_connection_error @@ -436,7 +436,7 @@ let open_stream t frame_header ?priority headers_block = { Stream.parse_state = AB.parse ~initial_buffer_size - (Hpack.Decoder.decode_headers t.hpack_decoder) + (Hpack.Decoder.headers t.hpack_decoder) ; end_stream = Flags.test_end_stream flags } in @@ -472,7 +472,7 @@ let process_trailer_headers t reqd active_stream frame_header headers_block = else let partial_headers = { Stream.parse_state = - AB.parse (Hpack.Decoder.decode_headers t.hpack_decoder) + AB.parse (Hpack.Decoder.headers t.hpack_decoder) (* obviously true at this point. *) ; end_stream } @@ -832,7 +832,8 @@ let process_settings_frame t { Frame.frame_header; _ } settings = * size of the header compression table used to decode header * blocks, in octets. *) t.settings.header_table_size <- x; - Hpack.Encoder.set_capacity t.hpack_encoder x + let table_size = min t.config.encoder_table_size x in + Hpack.Encoder.change_table_size t.hpack_encoder table_size | EnablePush, x -> (* We've already verified that this setting is either 0 or 1 in the * call to `Settings.check_settings_list` above. *) @@ -1093,6 +1094,7 @@ let create ; max_concurrent_streams = config.max_concurrent_streams ; initial_window_size = config.initial_window_size ; enable_push = config.enable_server_push + ; header_table_size = config.decoder_table_size } in let writer = Writer.create settings.max_frame_size in @@ -1200,8 +1202,8 @@ let create ; did_send_go_away = false ; unacked_settings = 0 ; wakeup_writer = ref default_wakeup_writer - ; hpack_encoder = Hpack.Encoder.(create settings.header_table_size) - ; hpack_decoder = Hpack.Decoder.(create settings.header_table_size) + ; hpack_encoder = Hpack.Encoder.create ~max_size:(min Settings.default_settings.header_table_size config.encoder_table_size) () + ; hpack_decoder = Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () } in Lazy.force t diff --git a/lib/settings.ml b/lib/settings.ml index ff0e316e..74ba06e5 100644 --- a/lib/settings.ml +++ b/lib/settings.ml @@ -211,4 +211,10 @@ let settings_for_the_connection settings = else settings_list in + let settings_list = + if settings.header_table_size <> default_settings.header_table_size then + (HeaderTableSize, settings.header_table_size) :: settings_list + else + settings_list + in settings_list diff --git a/lib/stream.ml b/lib/stream.ml index a2424c02..9fce246e 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -34,7 +34,7 @@ module AB = Angstrom.Buffered module Writer = Serialize.Writer type partial_headers = - { mutable parse_state : (Headers.t, Hpack.error) result AB.state + { mutable parse_state : Headers.header list AB.state ; end_stream : bool } diff --git a/lib_test/test_h2_client.ml b/lib_test/test_h2_client.ml index 934d594f..b23bf4d1 100644 --- a/lib_test/test_h2_client.ml +++ b/lib_test/test_h2_client.ml @@ -192,7 +192,7 @@ module Client_connection_tests = struct (* Well-formed HEADERS + CONTINUATION frames. *) let header_and_continuation_frames = - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -303,7 +303,7 @@ module Client_connection_tests = struct true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called @@ -350,7 +350,7 @@ module Client_connection_tests = struct true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder @@ -405,7 +405,7 @@ module Client_connection_tests = struct true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder @@ -561,7 +561,7 @@ module Client_connection_tests = struct true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder @@ -635,7 +635,7 @@ module Client_connection_tests = struct true (Flags.test_end_stream frame.frame_header.flags); report_write_result t (`Ok lenv); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder @@ -763,7 +763,7 @@ module Client_connection_tests = struct body" true (not (Stream.is_open stream)); - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in write_response t hpack_encoder (Response.create `OK); Alcotest.(check bool) "Response handler called" true !handler_called; Alcotest.(check bool) diff --git a/lib_test/test_h2_server.ml b/lib_test/test_h2_server.ml index 507d0904..8fa9ad5f 100644 --- a/lib_test/test_h2_server.ml +++ b/lib_test/test_h2_server.ml @@ -165,7 +165,7 @@ module Server_connection_tests = struct (* Well-formed HEADERS + CONTINUATION frames. *) let header_and_continuation_frames = - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -308,7 +308,7 @@ module Server_connection_tests = struct let config = { Config.default with read_buffer_size = max_length } in let t = create ~config ~error_handler default_request_handler in handle_preface t; - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -510,7 +510,7 @@ module Server_connection_tests = struct let test_dependent_stream () = let t = create ~error_handler data_request_handler in handle_preface t; - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -607,7 +607,7 @@ module Server_connection_tests = struct let test_server_push () = let t = create ~error_handler server_push_request_handler in handle_preface t; - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -728,7 +728,7 @@ module Server_connection_tests = struct in let t = create ~error_handler default_request_handler in handle_preface t; - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 @@ -777,7 +777,7 @@ module Server_connection_tests = struct in let t = create ~error_handler default_request_handler in handle_preface t; - let hpack_encoder = Hpack.Encoder.create 4096 in + let hpack_encoder = Hpack.Encoder.create () in let headers = { Frame.frame_header = { payload_length = 0 From 77173bca439752a0abbc74f449b3801951b9ad0c Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Tue, 2 Jul 2019 16:51:51 +0200 Subject: [PATCH 3/7] Hpack list is not reversed --- lib/headers.ml | 4 +--- lib/serialize.ml | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/headers.ml b/lib/headers.ml index c01da1cd..693182bf 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -55,8 +55,6 @@ let to_rev_list t = List.map (fun { name; value; _ } -> name, value) t let to_list t = List.rev (to_rev_list t) -let to_hpack_list t = List.rev t - exception Local module CI = struct @@ -278,7 +276,7 @@ let valid_headers ?(is_request = true) t = * after a regular header field MUST be treated as malformed * (Section 8.1.2.6). *) (is_pseudo && pseudo_did_end)) - (to_hpack_list t) + t in not invalid diff --git a/lib/serialize.ml b/lib/serialize.ml index 2fe12206..f25a8e27 100644 --- a/lib/serialize.ml +++ b/lib/serialize.ml @@ -473,7 +473,7 @@ module Writer = struct let encode_headers hpack_encoder faraday headers = List.iter (fun header -> Hpack.Encoder.encode_header hpack_encoder faraday header) - (Headers.to_hpack_list headers) + headers let write_request_like_frame t hpack_encoder ~write_frame frame_info request = let { Request.meth; target; scheme; headers } = request in From 43ce06bc344ba046bae49ad55f6d5f41d48c8a7d Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Tue, 2 Jul 2019 20:19:14 +0200 Subject: [PATCH 4/7] Remove slowtests --- .circleci/config.yml | 8 -------- Makefile | 3 --- 2 files changed, 11 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 077a4dbb..6982e2a0 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -52,11 +52,6 @@ opam-steps: &opam-steps eval `opam config env` dune build @all dune runtest --no-buffer - - run: - name: 'Slow Tests' - command: | - eval `opam config env` - dune build @slowtests --no-buffer - run: name: 'Conformance tests' command: | @@ -159,9 +154,6 @@ jobs: - run: name: 'esy test' command: ~/.npm-global/bin/esy b dune runtest --no-buffer - - run: - name: 'esy slow-test' - command: ~/.npm-global/bin/esy b dune build @slowtests --no-buffer - run: name: 'Check code is formatted with ocamlformat' command: | diff --git a/Makefile b/Makefile index 15af77ca..9368d11e 100644 --- a/Makefile +++ b/Makefile @@ -8,9 +8,6 @@ all: build test: esy b dune runtest --no-buffer -slow-test: - esy b dune build @slowtests --no-buffer - install: esy b dune install From 9665ad2dc655abfdfc0f7b1f8ba5de179c6b8112 Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Tue, 2 Jul 2019 20:19:59 +0200 Subject: [PATCH 5/7] ocamlformat --- lib/client_connection.ml | 15 ++++++++++----- lib/headers.ml | 7 +++++-- lib/server_connection.ml | 15 ++++++++++----- 3 files changed, 25 insertions(+), 12 deletions(-) diff --git a/lib/client_connection.ml b/lib/client_connection.ml index c75df456..5a53ca57 100644 --- a/lib/client_connection.ml +++ b/lib/client_connection.ml @@ -449,9 +449,7 @@ let create_partial_headers t flags headers_block = 2 * headers_block_length in { Stream.parse_state = - AB.parse - ~initial_buffer_size - (Hpack.Decoder.headers t.hpack_decoder) + AB.parse ~initial_buffer_size (Hpack.Decoder.headers t.hpack_decoder) ; end_stream = Flags.test_end_stream flags } @@ -1245,8 +1243,15 @@ let create ?(config = Config.default) ?push_handler ~error_handler = (* From RFC7540§4.3: * Header compression is stateful. One compression context and one * decompression context are used for the entire connection. *) - ; hpack_encoder = Hpack.Encoder.create ~max_size:(min Settings.default_settings.header_table_size config.encoder_table_size) () - ; hpack_decoder = Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () + ; hpack_encoder = + Hpack.Encoder.create + ~max_size: + (min + Settings.default_settings.header_table_size + config.encoder_table_size) + () + ; hpack_decoder = + Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () } in let t = Lazy.force t in diff --git a/lib/headers.ml b/lib/headers.ml index 693182bf..ce762828 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -106,7 +106,8 @@ let rec mem t name = false (* TODO: do we need to keep a list of never indexed fields? *) -let add t ?(never_index = false) name value = Hpack.Header.make ~never_index name value :: t +let add t ?(never_index = false) name value = + Hpack.Header.make ~never_index name value :: t let add_list t ls = of_rev_list ls @ t (* XXX(seliopou): do better here *) @@ -142,7 +143,9 @@ let replace t ?(never_index = false) name value = else nv' :: loop t n nv false in - try loop t name (Hpack.Header.make ~never_index name value) false with Local -> t + try loop t name (Hpack.Header.make ~never_index name value) false with + | Local -> + t let remove t name = let rec loop s n seen = diff --git a/lib/server_connection.ml b/lib/server_connection.ml index 84073fb4..01d121e1 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -434,9 +434,7 @@ let open_stream t frame_header ?priority headers_block = in let partial_headers = { Stream.parse_state = - AB.parse - ~initial_buffer_size - (Hpack.Decoder.headers t.hpack_decoder) + AB.parse ~initial_buffer_size (Hpack.Decoder.headers t.hpack_decoder) ; end_stream = Flags.test_end_stream flags } in @@ -1202,8 +1200,15 @@ let create ; did_send_go_away = false ; unacked_settings = 0 ; wakeup_writer = ref default_wakeup_writer - ; hpack_encoder = Hpack.Encoder.create ~max_size:(min Settings.default_settings.header_table_size config.encoder_table_size) () - ; hpack_decoder = Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () + ; hpack_encoder = + Hpack.Encoder.create + ~max_size: + (min + Settings.default_settings.header_table_size + config.encoder_table_size) + () + ; hpack_decoder = + Hpack.Decoder.create ~max_size_limit:config.decoder_table_size () } in Lazy.force t From a9bad326713dcae20f750ac1d21000ea44aee817 Mon Sep 17 00:00:00 2001 From: Pieter Goetschalckx <3.14.e.ter@gmail.com> Date: Tue, 2 Jul 2019 20:44:37 +0200 Subject: [PATCH 6/7] Update opam config --- .circleci/config.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 6982e2a0..38d19308 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,7 +1,7 @@ version: 2 common_cache_key: &common_cache_key - key: dependency-cache-{{ checksum "../ocaml-version" }}-{{ checksum ".circleci/config.yml" }}-{{ checksum "hpack.opam" }}-{{ checksum "h2.opam" }}-{{ checksum "h2-lwt.opam" }}-{{ checksum "h2-lwt-unix.opam" }}-{{ checksum "h2-mirage.opam" }} + key: dependency-cache-{{ checksum "../ocaml-version" }}-{{ checksum ".circleci/config.yml" }}-{{ checksum "h2.opam" }}-{{ checksum "h2-lwt.opam" }}-{{ checksum "h2-lwt-unix.opam" }}-{{ checksum "h2-mirage.opam" }} esy_cache_key: &esy_cache_key key: esy-cache-{{ checksum "esy.json" }}-{{ checksum "../esy-checksum" }}-{{ checksum ".circleci/config.yml" }} @@ -37,6 +37,7 @@ opam-steps: &opam-steps opam pin add -y httpaf --dev-repo opam pin add -y httpaf-lwt-unix git+https://github.com/anmonteiro/httpaf#anmonteiro/lwt-https-support opam pin add -y ssl git+https://github.com/anmonteiro/ocaml-ssl#alpn + opam pin add -y hpack git+https://github.com/314eter/ocaml-hpack opam install -y lwt_ssl opam install -t --deps-only . - run: From 3edea24d5ac4ad6e938a92e60a52d10824bab946 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 2 Jul 2019 16:26:38 -0700 Subject: [PATCH 7/7] Pin a specific HPACK commit --- .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 38d19308..ee06f12d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -37,7 +37,7 @@ opam-steps: &opam-steps opam pin add -y httpaf --dev-repo opam pin add -y httpaf-lwt-unix git+https://github.com/anmonteiro/httpaf#anmonteiro/lwt-https-support opam pin add -y ssl git+https://github.com/anmonteiro/ocaml-ssl#alpn - opam pin add -y hpack git+https://github.com/314eter/ocaml-hpack + opam pin add -y hpack git+https://github.com/314eter/ocaml-hpack#8077a85 opam install -y lwt_ssl opam install -t --deps-only . - run: