diff --git a/src/mte.ml b/src/mte.ml index 935ea582..888a0048 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -52,6 +52,80 @@ module Header_util = struct | `Identity :: _ -> None | `DEFLATE :: _ -> Some `DEFLATE | `Gzip :: _ -> Some `Gzip + + module Etag : sig + (* TODO + - test + - don't ignore broken etag format *) + [@@@ocaml.warning "-32"] + + (* https://httpwg.org/specs/rfc9110.html#field.etag + module to parse < "*" / #entity-tag > + for If-Match and If-None-Match header value *) + type etag = private { weak: bool; value: string } + type t = Any_etag | Etag_list of etag list + + val parse : string -> t + val of_crockford32 : string -> (t, string) result + val to_field_value : t -> string + end = struct + type etag = { weak: bool; value: string } + type t = Any_etag | Etag_list of etag list + + let invalid_etag = Error "invalid Etag field" + + let is_valid_etag_string s = + let f c = + let n = Char.code c in + (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF) + in + String.for_all f s + + let pp_etag ppf { weak; value } = + if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value + + let pp_etag_list = Fmt.list ~sep:(Fmt.any ", ") pp_etag + + let pp ppf = function + | Any_etag -> Fmt.pf ppf "*" + | Etag_list etags -> Fmt.pf ppf "%a" pp_etag_list etags + + let to_field_value t = Fmt.str "%a" pp t + + let of_crockford32 s = + (* always weak for If-None-Match *) + let weak = true in + match is_valid_etag_string s with + | false -> invalid_etag + | true -> + let v = Etag_list [ { weak; value= s } ] in + Ok v + + let unquote s = + let len = String.length s in + if len >= 2 && s.[0] = '"' && s.[len - 1] = '"' then + Ok (String.sub s 1 (len - 2)) + else invalid_etag + + let parse s = + if String.trim s = "*" then Any_etag + else + String.split_on_char ',' s + |> List.map String.trim + |> List.filter (( <> ) "") + |> List.map (fun s -> + (* "W/" is the weak comparison indicator *) + let weak, s = + if String.starts_with ~prefix:"W/" s then + (true, String.sub s 2 (String.length s - 2)) + else (false, s) + in + Result.bind (unquote s) (fun s -> + if is_valid_etag_string s then Ok { weak; value= s } + else invalid_etag)) + |> List.filter_map Result.to_option + |> fun l -> Etag_list l + end end module Static = struct @@ -98,7 +172,7 @@ module Static = struct in let compression = Header_util.select_encoding headers in let* () = Vif.Response.with_string ?compression req data in - let* () = Vif.Response.add ~field:"ETAG" (Assets.etag kind) in + let* () = Vif.Response.add ~field:"etag" (Assets.etag kind) in (* TODO content-type *) let* () = Vif.Response.add ~field:"content-type" "html; charset=utf-8" in Vif.Response.respond `OK