anil.recoil.org
OCaml HTML5 parser/serialiser based on Python's JustHTML
1(** Form-related validation checker implementation.
2
3 Currently only validates autocomplete attributes since other form validation
4 checks (like button-outside-form and label references) don't match
5 Nu validator's behavior. *)
6
7type state = unit
8
9let create () = ()
10
11let reset _state = ()
12
13(** Get the value of an attribute if present. *)
14let get_attr name attrs =
15 List.find_map
16 (fun (attr_name, value) ->
17 if String.equal attr_name name then Some value else None)
18 attrs
19
20(** Check if autocomplete value contains webauthn token *)
21let contains_webauthn value =
22 let lower = String.lowercase_ascii value in
23 let tokens = String.split_on_char ' ' lower |> List.filter (fun s -> String.length s > 0) in
24 List.mem "webauthn" tokens
25
26let check_autocomplete_value value element_name collector =
27 (* webauthn is not allowed on select, only on input and textarea *)
28 if element_name = "select" && contains_webauthn value then begin
29 Message_collector.add_error collector
30 ~message:(Printf.sprintf "The value of the \xe2\x80\x9cautocomplete\xe2\x80\x9d attribute for the \xe2\x80\x9c%s\xe2\x80\x9d element must not contain \xe2\x80\x9cwebauthn\xe2\x80\x9d."
31 element_name)
32 ~code:"bad-attribute-value"
33 ~element:element_name
34 ~attribute:"autocomplete" ()
35 end else begin
36 (* Use the proper autocomplete validator from dt_autocomplete *)
37 match Dt_autocomplete.validate_autocomplete value with
38 | Ok () -> ()
39 | Error msg ->
40 Message_collector.add_error collector
41 ~message:(Printf.sprintf "Bad value \xe2\x80\x9c%s\xe2\x80\x9d for attribute \xe2\x80\x9cautocomplete\xe2\x80\x9d on element \xe2\x80\x9c%s\xe2\x80\x9d: %s"
42 value element_name msg)
43 ~code:"bad-attribute-value"
44 ~element:element_name
45 ~attribute:"autocomplete" ()
46 end
47
48let start_element _state ~name ~namespace:_ ~attrs collector =
49 (* Check autocomplete attribute on form elements *)
50 match name with
51 | "input" | "select" | "textarea" ->
52 (match get_attr "autocomplete" attrs with
53 | Some autocomplete_value ->
54 check_autocomplete_value autocomplete_value name collector
55 | None -> ())
56 | _ -> ()
57
58let end_element _state ~name:_ ~namespace:_ _collector = ()
59
60let characters _state _text _collector = ()
61
62let end_document _state _collector = ()
63
64let checker = (module struct
65 type nonrec state = state
66
67 let create = create
68 let reset = reset
69 let start_element = start_element
70 let end_element = end_element
71 let characters = characters
72 let end_document = end_document
73end : Checker.S)