diff --git a/src/headers_lib.ml b/src/headers_lib.ml index 2357f897..3cd4b401 100644 --- a/src/headers_lib.ml +++ b/src/headers_lib.ml @@ -39,49 +39,45 @@ end = struct let v = { weak= true; value= t } in Fmt.str "%a" pp_header_etag_item v - let invalid_etag = Error "invalid etag field" + let is_valid_char c = + let n = Char.code c in + (n >= 0x21 && n <= 0x7E && n <> 0x22) || (n >= 0x80 && n <= 0xFF) - 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 has_valid_charset s = String.for_all is_valid_char s let of_crockford32 s = - match has_valid_charset s with false -> invalid_etag | true -> Ok s + match has_valid_charset s with + | false -> Error "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 = + let open Angstrom in + let ws = skip_while (function ' ' -> true | _ -> false) in + let quoted_string = + char '"' *> take_till (fun c -> c = '"') <* char '"' >>= fun s -> + if String.for_all is_valid_char s then return s + else fail "found illegal char" + in + let item = + ws + *> lift2 + (fun weak value -> { weak; value }) + (option false (string "W/" *> return true)) + quoted_string + <* ws + in + let comma = ws *> char ',' *> ws in + let list_of_items = sep_by1 comma item in + let parse_header_value = + char '*' *> return Any_etag + <|> (list_of_items >>| fun items -> Etag_list items) + <* end_of_input + in + fun s -> + match parse_string ~consume:Consume.All parse_header_value s with + | Error e -> Fmt.error "invalid etag: %s" e + | Ok v -> Ok v - (* TODO angstrom parser instead *) - 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 diff --git a/test/test.ml b/test/test.ml index 9e109112..3f0f835f 100644 --- a/test/test.ml +++ b/test/test.ml @@ -37,3 +37,32 @@ let () = let r = of_string {|+EUR:4.99999999999999999999999|} in assert (Result.is_error r); () + +let () = + let open Headers_lib.Etag in + let check input = assert (Result.is_ok (parse input)) in + let check_bad input = assert (Result.is_error (parse input)) in + + check "*"; + check "\"foo\""; + check "W/\"foo\""; + check "\"foo\", \"bar\""; + check " W/\"x\" , W/\"y\" , \"z\" "; + check " \"one\" , \"two\" , \"three\" "; + check "W/\"a\""; + check " W/\"a\" , \"b\""; + + check_bad ""; + check_bad "foo"; + check_bad "W/foo"; + check_bad "W/\"unterminated"; + check_bad "\"foo\", W/"; + check_bad "* , \"bar\""; + check_bad "\"a\" \"b\""; + check_bad "W/\"a\" W/\"b\""; + check_bad "\"fo\x7Fo\""; + + (* TODO trailing comma are valid actually, I think *) + check_bad "\"foo\" ,"; + check_bad ", \"foo\""; + ()