292 lines
11 KiB
OCaml
292 lines
11 KiB
OCaml
|
(*----------------------------------------------------------------------------
|
||
|
|
* Copyright (c) 2019-2020 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.
|
||
|
|
*---------------------------------------------------------------------------*)
|
||
|
|
|
||
|
|
module WindowSize = struct
|
||
|
|
type t = int32
|
||
|
|
|
||
|
|
(* From RFC7540§6.9.2:
|
||
|
|
* When an HTTP/2 connection is first established, new streams are created
|
||
|
|
* with an initial flow-control window size of 65,535 octets. *)
|
||
|
|
let default_initial_window_size = 65535l
|
||
|
|
|
||
|
|
(* From RFC7540§6.9:
|
||
|
|
* The legal range for the increment to the flow-control window is 1 to
|
||
|
|
* 2^31-1 (2,147,483,647) octets. *)
|
||
|
|
let max_window_size = Int32.max_int
|
||
|
|
|
||
|
|
(* Ideally `n` here would be an unsigned 32-bit integer, but OCaml doesn't
|
||
|
|
* support them. We avoid introducing a new dependency on an unsigned integer
|
||
|
|
* library by letting it overflow at parse time and checking if bit 31 is set
|
||
|
|
* here, since * `Window.max_window_size` is never allowed to be above
|
||
|
|
* 2^31-1 (see `max_window_size` above).
|
||
|
|
* See http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/f1c483068cc62075c916f7ad7d640ce0.fr.html
|
||
|
|
* for more info. *)
|
||
|
|
let is_window_overflow n = Util.test_bit_int32 n 31
|
||
|
|
end
|
||
|
|
|
||
|
|
type setting =
|
||
|
|
| HeaderTableSize of int
|
||
|
|
| EnablePush of int
|
||
|
|
| MaxConcurrentStreams of int32
|
||
|
|
| InitialWindowSize of int32
|
||
|
|
| MaxFrameSize (* this means payload size *) of int
|
||
|
|
| MaxHeaderListSize of int
|
||
|
|
|
||
|
|
type settings_list = setting list
|
||
|
|
|
||
|
|
(* From RFC7540§6.5.1:
|
||
|
|
* The payload of a SETTINGS frame consists of zero or more parameters,
|
||
|
|
* each consisting of an unsigned 16-bit setting identifier and an
|
||
|
|
* unsigned 32-bit value. *)
|
||
|
|
let octets_per_setting = 6
|
||
|
|
|
||
|
|
let serialize_key = function
|
||
|
|
| HeaderTableSize _ -> 0x1
|
||
|
|
| EnablePush _ -> 0x2
|
||
|
|
| MaxConcurrentStreams _ -> 0x3
|
||
|
|
| InitialWindowSize _ -> 0x4
|
||
|
|
| MaxFrameSize _ -> 0x5
|
||
|
|
| MaxHeaderListSize _ -> 0x6
|
||
|
|
|
||
|
|
let check_value ~is_client = function
|
||
|
|
| EnablePush v ->
|
||
|
|
if v <> 0 && v <> 1
|
||
|
|
then
|
||
|
|
(* From RFC7540§6.5.2
|
||
|
|
* The initial value is 1, which indicates that server push is
|
||
|
|
* permitted. Any value other than 0 or 1 MUST be treated as a
|
||
|
|
* connection error (Section 5.4.1) of type PROTOCOL_ERROR. *)
|
||
|
|
Error
|
||
|
|
Error.(
|
||
|
|
ConnectionError (ProtocolError, "SETTINGS_ENABLE_PUSH must be 0 or 1"))
|
||
|
|
else if is_client && v = 1
|
||
|
|
then
|
||
|
|
(* From RFC7540§8.2:
|
||
|
|
* Clients MUST reject any attempt to change the
|
||
|
|
* SETTINGS_ENABLE_PUSH setting to a value other than 0 by
|
||
|
|
* treating the message as a connection error (Section 5.4.1) of
|
||
|
|
* type PROTOCOL_ERROR. *)
|
||
|
|
Error
|
||
|
|
Error.(
|
||
|
|
ConnectionError
|
||
|
|
(ProtocolError, "Server must not try to enable SETTINGS_ENABLE_PUSH"))
|
||
|
|
else Ok ()
|
||
|
|
| InitialWindowSize v when WindowSize.is_window_overflow v ->
|
||
|
|
(* From RFC7540§6.5.2
|
||
|
|
* Values above the maximum flow-control window size of 2^31-1 MUST be
|
||
|
|
* treated as a connection error (Section 5.4.1) of type
|
||
|
|
* FLOW_CONTROL_ERROR. *)
|
||
|
|
Error
|
||
|
|
Error.(
|
||
|
|
ConnectionError
|
||
|
|
( FlowControlError
|
||
|
|
, Format.sprintf
|
||
|
|
"Window size must be less than or equal to %ld"
|
||
|
|
WindowSize.max_window_size ))
|
||
|
|
| MaxFrameSize v when v < 16384 || v > 16777215 ->
|
||
|
|
(* From RFC7540§6.5.2
|
||
|
|
* The initial value is 214 (16,384) octets. The value advertised by an
|
||
|
|
* endpoint MUST be between this initial value and the maximum allowed
|
||
|
|
* frame size (224-1 or 16,777,215 octets), inclusive. Values outside
|
||
|
|
* this range MUST be treated as a connection error (Section 5.4.1) of
|
||
|
|
* type PROTOCOL_ERROR. *)
|
||
|
|
Error
|
||
|
|
Error.(
|
||
|
|
ConnectionError
|
||
|
|
(ProtocolError, "Max frame size must be in the 16384 - 16777215 range"))
|
||
|
|
| _ -> Ok ()
|
||
|
|
|
||
|
|
(* Check incoming settings and report an error if any. *)
|
||
|
|
let check_settings_list ?(is_client = false) settings =
|
||
|
|
let rec loop = function
|
||
|
|
| [] -> Ok ()
|
||
|
|
| x :: xs ->
|
||
|
|
(match check_value ~is_client x with
|
||
|
|
| Ok () -> loop xs
|
||
|
|
| Error _ as err -> err)
|
||
|
|
in
|
||
|
|
loop settings
|
||
|
|
|
||
|
|
type t =
|
||
|
|
{ header_table_size : int
|
||
|
|
; enable_push : bool
|
||
|
|
; max_concurrent_streams : int32
|
||
|
|
; (* Indicates the amount tokens the peer allows an H2 endpoint to send. *)
|
||
|
|
initial_window_size : WindowSize.t
|
||
|
|
; max_frame_size : int
|
||
|
|
; max_header_list_size : int option
|
||
|
|
}
|
||
|
|
|
||
|
|
(* From RFC7540§11.3 *)
|
||
|
|
let default =
|
||
|
|
{ header_table_size = 0x1000
|
||
|
|
; enable_push =
|
||
|
|
true
|
||
|
|
(* From RFC7540§6.5.2:
|
||
|
|
* SETTINGS_MAX_CONCURRENT_STREAMS (0x3): [...] Initially, there is no
|
||
|
|
* limit to this value. *)
|
||
|
|
; max_concurrent_streams = Int32.max_int
|
||
|
|
; initial_window_size = WindowSize.default_initial_window_size
|
||
|
|
; max_frame_size = 0x4000
|
||
|
|
; max_header_list_size = None
|
||
|
|
}
|
||
|
|
|
||
|
|
let settings_for_the_connection settings =
|
||
|
|
let settings_list =
|
||
|
|
if settings.max_frame_size <> default.max_frame_size
|
||
|
|
then [ MaxFrameSize settings.max_frame_size ]
|
||
|
|
else []
|
||
|
|
in
|
||
|
|
let settings_list =
|
||
|
|
if settings.max_concurrent_streams <> default.max_concurrent_streams
|
||
|
|
then MaxConcurrentStreams settings.max_concurrent_streams :: settings_list
|
||
|
|
else settings_list
|
||
|
|
in
|
||
|
|
let settings_list =
|
||
|
|
if settings.initial_window_size <> default.initial_window_size
|
||
|
|
then
|
||
|
|
(* FIXME: don't convert *)
|
||
|
|
InitialWindowSize settings.initial_window_size :: settings_list
|
||
|
|
else settings_list
|
||
|
|
in
|
||
|
|
let settings_list =
|
||
|
|
if settings.enable_push <> default.enable_push
|
||
|
|
then EnablePush (if settings.enable_push then 1 else 0) :: settings_list
|
||
|
|
else settings_list
|
||
|
|
in
|
||
|
|
settings_list
|
||
|
|
|
||
|
|
let parse_settings_payload num_settings =
|
||
|
|
let open Angstrom in
|
||
|
|
let rec parse_inner acc remaining =
|
||
|
|
(* From RFC7540§6.5.3:
|
||
|
|
* The values in the SETTINGS frame MUST be processed in the order
|
||
|
|
* they appear, with no other frame processing between values. *)
|
||
|
|
if remaining <= 0
|
||
|
|
then return (List.rev acc)
|
||
|
|
else
|
||
|
|
lift2
|
||
|
|
(fun k (v : int32) ->
|
||
|
|
match k with
|
||
|
|
| 0x1 -> HeaderTableSize (Int32.to_int v) :: acc
|
||
|
|
| 0x2 -> EnablePush (Int32.to_int v) :: acc
|
||
|
|
| 0x3 -> MaxConcurrentStreams v :: acc
|
||
|
|
| 0x4 -> InitialWindowSize v :: acc
|
||
|
|
| 0x5 -> MaxFrameSize (Int32.to_int v) :: acc
|
||
|
|
| 0x6 -> MaxHeaderListSize (Int32.to_int v) :: acc
|
||
|
|
| _ ->
|
||
|
|
(* Note: This ignores unknown settings.
|
||
|
|
*
|
||
|
|
* From RFC7540§6.5.3:
|
||
|
|
* Unsupported parameters MUST be ignored.
|
||
|
|
*)
|
||
|
|
acc)
|
||
|
|
BE.any_uint16
|
||
|
|
BE.any_int32
|
||
|
|
>>= fun acc' -> parse_inner acc' (remaining - 1)
|
||
|
|
in
|
||
|
|
parse_inner [] num_settings
|
||
|
|
|
||
|
|
let write_settings_payload t settings_list =
|
||
|
|
let open Faraday in
|
||
|
|
List.iter
|
||
|
|
(fun setting ->
|
||
|
|
(* From RFC7540§6.5.1:
|
||
|
|
* The payload of a SETTINGS frame consists of zero or more parameters,
|
||
|
|
* each consisting of an unsigned 16-bit setting identifier and an
|
||
|
|
* unsigned 32-bit value. *)
|
||
|
|
BE.write_uint16 t (serialize_key setting);
|
||
|
|
match setting with
|
||
|
|
| MaxConcurrentStreams value | InitialWindowSize value ->
|
||
|
|
BE.write_uint32 t value
|
||
|
|
| HeaderTableSize value
|
||
|
|
| EnablePush value
|
||
|
|
| MaxFrameSize value
|
||
|
|
| MaxHeaderListSize value ->
|
||
|
|
BE.write_uint32 t (Int32.of_int value))
|
||
|
|
settings_list
|
||
|
|
|
||
|
|
let of_settings_list settings =
|
||
|
|
List.fold_left
|
||
|
|
(fun (acc : t) item ->
|
||
|
|
match item with
|
||
|
|
| HeaderTableSize x -> { acc with header_table_size = x }
|
||
|
|
| EnablePush x -> { acc with enable_push = x = 1 }
|
||
|
|
| MaxConcurrentStreams x -> { acc with max_concurrent_streams = x }
|
||
|
|
| InitialWindowSize new_val -> { acc with initial_window_size = new_val }
|
||
|
|
| MaxFrameSize x -> { acc with max_frame_size = x }
|
||
|
|
| MaxHeaderListSize x -> { acc with max_header_list_size = Some x })
|
||
|
|
default
|
||
|
|
settings
|
||
|
|
|
||
|
|
let of_base64 encoded =
|
||
|
|
match Base64.decode ~alphabet:Base64.uri_safe_alphabet encoded with
|
||
|
|
| Ok settings_payload ->
|
||
|
|
let settings_payload_length =
|
||
|
|
String.length settings_payload / octets_per_setting
|
||
|
|
in
|
||
|
|
(match
|
||
|
|
Angstrom.parse_string
|
||
|
|
~consume:All
|
||
|
|
(parse_settings_payload settings_payload_length)
|
||
|
|
settings_payload
|
||
|
|
with
|
||
|
|
| Ok settings -> Ok (of_settings_list settings)
|
||
|
|
| Error _ as e -> e)
|
||
|
|
| Error (`Msg msg) -> Error msg
|
||
|
|
|
||
|
|
let to_base64 t =
|
||
|
|
let settings = settings_for_the_connection t in
|
||
|
|
let faraday = Faraday.create (List.length settings * 6) in
|
||
|
|
write_settings_payload faraday settings;
|
||
|
|
let settings_hex = Faraday.serialize_to_string faraday in
|
||
|
|
match Base64.encode ~alphabet:Base64.uri_safe_alphabet settings_hex with
|
||
|
|
| Ok r -> Ok r
|
||
|
|
| Error (`Msg msg) -> Error msg
|
||
|
|
|
||
|
|
let pp_hum formatter t =
|
||
|
|
let pp_elem formatter setting =
|
||
|
|
let key, value =
|
||
|
|
match setting with
|
||
|
|
| HeaderTableSize v -> "HEADER_TABLE_SIZE", Int64.of_int v
|
||
|
|
| EnablePush v -> "ENABLE_PUSH", Int64.of_int v
|
||
|
|
| MaxConcurrentStreams v -> "MAX_CONCURRENT_STREAMS", Int64.of_int32 v
|
||
|
|
| InitialWindowSize v -> "INITIAL_WINDOW_SIZE", Int64.of_int32 v
|
||
|
|
| MaxFrameSize v -> "MAX_FRAME_SIZE", Int64.of_int v
|
||
|
|
| MaxHeaderListSize v -> "MAX_HEADER_LIST_SIZE", Int64.of_int v
|
||
|
|
in
|
||
|
|
Format.fprintf formatter "@[(%S %Ld)@]" key value
|
||
|
|
in
|
||
|
|
Format.fprintf formatter "@[(";
|
||
|
|
Format.pp_print_list pp_elem formatter (settings_for_the_connection t);
|
||
|
|
Format.fprintf formatter ")@]"
|