diff --git a/src/assets.ml b/src/assets.ml index 156cdcfd..3c8676ff 100644 --- a/src/assets.ml +++ b/src/assets.ml @@ -102,12 +102,13 @@ let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr (* ! lang and mime must be supported *) let get_content ~lang ~mime t = + let etag = Headers_lib.Etag.to_raw_string (etag t) in let ext = match Util.mimetype_to_extension mime with | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime) | Some ext -> ext in - let path = Fpath.to_string Fpath.((base_dir t / lang / etag t) + ext) in + let path = Fpath.to_string Fpath.((base_dir t / lang / etag) + ext) in match Assets_crunch.read path with | None -> Fmt.failwith "static file not found: `%s`" path | Some data -> data diff --git a/src/config.ml b/src/config.ml index f85674af..7960b13c 100644 --- a/src/config.ml +++ b/src/config.ml @@ -17,7 +17,7 @@ let privacy_dir = Fpath.(v "privacy") (* ETAG is used as base filename it should be encoded in Crockford base-32 we do not generate it and we do not verify it *) -let terms_etag = "0" -let privacy_etag = "0" +let terms_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok +let privacy_etag = "0" |> Headers_lib.Etag.of_crockford32 |> Result.get_ok let terms_legal_version = "1" let privacy_legal_version = "1" diff --git a/src/dune b/src/dune index 5abab20a..19e30781 100644 --- a/src/dune +++ b/src/dune @@ -1,8 +1,25 @@ (executable (public_name mte) (name mte) - (modules assets assets_crunch headers mte config util syntax) - (libraries vif fmt jsont cohttp)) + (modules assets assets_crunch headers mte config util) + (libraries + headers_lib + syntax + ; + vif + fmt + jsont + cohttp)) + +(library + (name headers_lib) + (modules headers_lib) + (libraries fmt syntax)) + +(library + (name syntax) + (modules syntax) + (libraries)) (rule (target assets_crunch.ml) diff --git a/src/headers.ml b/src/headers.ml index 94868650..4e10975d 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -42,84 +42,3 @@ let select_encoding headers = | `Identity :: _ -> None | `DEFLATE :: _ -> Some `DEFLATE | `Gzip :: _ -> Some `Gzip - -(* TODO(etag) - - test - - don't ignore invalid_etag - - can still bypass this module and directly set Etag header - but its fine *) -module Etag : sig - (* https://httpwg.org/specs/rfc9110.html#field.etag - module to parse < "*" / #entity-tag >, - used for If-Match and If-None-Match headers *) - type t - type header_value - - val parse : string -> (header_value, string) result - val of_crockford32 : string -> (t, string) result - val to_field_value : t -> string - val evaluate : t -> header_value -> bool -end = struct - (* raw etag *) - type t = string - - (* type for the value of header field *) - type header_etag_item = { weak: bool; value: string } - type header_value = Any_etag | Etag_list of header_etag_item list - - let pp_header_etag_item ppf { weak; value } = - if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value - - let to_field_value t = - (* always weak comparison for If-None-Match header *) - let v = { weak= true; value= t } in - Fmt.str "%a" pp_header_etag_item v - - let invalid_etag = Error "invalid etag field" - - let has_valid_charset 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 of_crockford32 s = - match has_valid_charset s with false -> invalid_etag | true -> Ok s - - let trim_dquote 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 Ok Any_etag - else - String.split_on_char ',' s - |> List.map String.trim - |> List.filter (( <> ) "") - |> Syntax.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 (trim_dquote s) (fun s -> - if has_valid_charset s then Ok { weak; value= s } - else invalid_etag)) - |> Result.map (fun l -> Etag_list l) - - (* To evaluate a received If-None-Match header field: - - If the field value is "*", the condition is false - if the origin server has a current representation for the target resource. - - If the field value is a list of entity tags, the condition is false - if one of the listed tags matches the entity tag of the selected representation. - - Otherwise, the condition is true. *) - let evaluate t header_value = - match header_value with - | Any_etag -> false - | Etag_list l -> - not @@ List.exists (fun { weak= _; value } -> String.equal t value) l -end diff --git a/src/headers_lib.ml b/src/headers_lib.ml new file mode 100644 index 00000000..079c176d --- /dev/null +++ b/src/headers_lib.ml @@ -0,0 +1,84 @@ +(* independent module for headers fields value *) + +(* TODO + - test + - can still bypass this module and directly set Etag header, but its fine *) +module Etag : sig + (* module to parse < "*" / #entity-tag >, + used for If-Match and If-None-Match headers + + https://httpwg.org/specs/rfc9110.html#field.etag *) + type t + type header_value + + val parse : string -> (header_value, string) result + val of_crockford32 : string -> (t, string) result + val to_raw_string : t -> string + val to_field_value : t -> string + val evaluate : t -> header_value -> bool +end = struct + (* raw etag *) + type t = string + + (* type for the value of header field *) + type header_etag_item = { weak: bool; value: string } + type header_value = Any_etag | Etag_list of header_etag_item list + + let pp_header_etag_item ppf { weak; value } = + if weak then Fmt.pf ppf {|W/"%s"|} value else Fmt.pf ppf {|"%s"|} value + + let to_raw_string t = t + + let to_field_value t = + (* always weak comparison for If-None-Match header *) + let v = { weak= true; value= t } in + Fmt.str "%a" pp_header_etag_item v + + let invalid_etag = Error "invalid etag field" + + let has_valid_charset 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 of_crockford32 s = + match has_valid_charset s with false -> invalid_etag | true -> Ok s + + let trim_dquote 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 Ok Any_etag + else + String.split_on_char ',' s + |> List.map String.trim + |> List.filter (( <> ) "") + |> Syntax.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 (trim_dquote s) (fun s -> + if has_valid_charset s then Ok { weak; value= s } + else invalid_etag)) + |> Result.map (fun l -> Etag_list l) + + (* To evaluate a received If-None-Match header field: + - If the field value is "*", the condition is false + if the origin server has a current representation for the target resource. + - If the field value is a list of entity tags, the condition is false + if one of the listed tags matches the entity tag of the selected representation. + - Otherwise, the condition is true. *) + let evaluate t header_value = + match header_value with + | Any_etag -> false + | Etag_list l -> + not @@ List.exists (fun { weak= _; value } -> String.equal t value) l +end diff --git a/src/mte.ml b/src/mte.ml index 07da0c54..b1c6c913 100644 --- a/src/mte.ml +++ b/src/mte.ml @@ -29,16 +29,13 @@ module Static = struct | Error e -> Fmt.failwith "TODO handle me, %s" e | Ok v -> v in - let etag = - (* TODO keep our static asset etag as Etag.t in Config? *) - Assets.etag kind |> Headers.Etag.of_crockford32 |> Result.get_ok - in + let etag = Assets.etag kind in let headers = Vif.Request.headers req in let has_matching_etag = match Vif.Headers.get headers "if-none-match" with | None -> false | Some s -> - s |> Headers.Etag.parse |> get_ok |> Headers.Etag.evaluate etag + Headers_lib.Etag.parse s |> get_ok |> Headers_lib.Etag.evaluate etag in match has_matching_etag with | true -> @@ -54,7 +51,7 @@ module Static = struct let open Vif.Response.Syntax in let* () = Vif.Response.with_string ?compression req data in let* () = - let etag_field_value = Headers.Etag.to_field_value etag in + let etag_field_value = Headers_lib.Etag.to_field_value etag in Vif.Response.add ~field:"etag" etag_field_value in let* () =