swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

add headers_lib

Browse source
This commit is contained in:
Swrup 2025-09-28 21:27:15 +02:00
parent 72426790b4
commit 4cbf3c722c
6 changed files with 110 additions and 92 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/assets.ml
View file

@ -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

4
src/config.ml
View file

@ -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"

21
src/dune
View file

@ -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)

81
src/headers.ml
View file

@ -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

84
src/headers_lib.ml Normal file
View file

@ -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

9
src/mte.ml
View file

@ -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* () =