simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-07 11:45:36 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix: %X for percent_encode; use percent_decode in parse_query

Browse source
This commit is contained in:
Simon Cruanes 2019-11-26 19:22:21 -06:00
parent eab754ec95
commit 4d852f3cd3
2 changed files with 22 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/Tiny_httpd_util.ml
View file

@ -1,7 +1,7 @@
(* test utils *) (* test utils *)
(*$inject (*$inject
let pp_res f = function Ok x -> f x | Error e -> Printexc.to_string e let pp_res f = function Ok x -> f x | Error e -> e
let pp_res_query = (Q.Print.(pp_res (list (pair string string)))) let pp_res_query = (Q.Print.(pp_res (list (pair string string))))
let err_map f = function Ok x-> Ok (f x) | Error e -> Error e let err_map f = function Ok x-> Ok (f x) | Error e -> Error e
let sort_l l = List.sort compare l let sort_l l = List.sort compare l
@ -17,7 +17,7 @@ let percent_encode ?(skip=fun _->false) s =
| (' ' | '!' | '"' | '#' | '$' | '%' | '&' | '\'' | '(' | ')' | '*' | '+' | (' ' | '!' | '"' | '#' | '$' | '%' | '&' | '\'' | '(' | ')' | '*' | '+'
| ',' | '/' | ':' | ';' | '=' | '?' | '@' | '[' | ']' | '~') | ',' | '/' | ':' | ';' | '=' | '?' | '@' | '[' | ']' | '~')
as c -> as c ->
Printf.bprintf buf "%%%x" (Char.code c) Printf.bprintf buf "%%%X" (Char.code c)
| c -> Buffer.add_char buf c) | c -> Buffer.add_char buf c)
s; s;
Buffer.contents buf Buffer.contents buf
@ -25,7 +25,11 @@ let percent_encode ?(skip=fun _->false) s =
(*$= & ~printer:(fun s->s) (*$= & ~printer:(fun s->s)
"hello%20world" (percent_encode "hello world") "hello%20world" (percent_encode "hello world")
"%23%25^%24%40^%40" (percent_encode "#%^$@^@") "%23%25^%24%40^%40" (percent_encode "#%^$@^@")
"a%20ohm%2b5235%25%26%40%23%20---%20_" (percent_encode "a ohm+5235%&@# --- _") "a%20ohm%2B5235%25%26%40%23%20---%20_" (percent_encode "a ohm+5235%&@# --- _")
*)
(*$= & ~printer:Q.(Print.(option string))
(Some "?") (percent_decode @@ percent_encode "?")
*) *)
let hex_int (s:string) : int = Scanf.sscanf s "%x" (fun x->x) let hex_int (s:string) : int = Scanf.sscanf s "%x" (fun x->x)
@ -60,16 +64,21 @@ let percent_decode (s:string) : _ option =
| None -> Q.Test.fail_report "invalid percent encoding") | None -> Q.Test.fail_report "invalid percent encoding")
*) *)
let parse_query s : (_ list, _) result= exception Invalid_query
let parse_query s : (_ list, string) result=
let pairs = ref [] in let pairs = ref [] in
let is_sep_ = function '&' | ';' -> true | _ -> false in let is_sep_ = function '&' | ';' -> true | _ -> false in
try
let i = ref 0 in let i = ref 0 in
let j = ref 0 in let j = ref 0 in
try
let percent_decode s =
match percent_decode s with Some x -> x | None -> raise Invalid_query
in
let parse_pair () = let parse_pair () =
let eq = String.index_from s !i '=' in let eq = String.index_from s !i '=' in
let k = String.sub s !i (eq- !i) in let k = percent_decode @@ String.sub s !i (eq- !i) in
let v = String.sub s (eq+1) (!j-eq-1) in let v = percent_decode @@ String.sub s (eq+1) (!j-eq-1) in
pairs := (k,v) :: !pairs; pairs := (k,v) :: !pairs;
in in
while !i < String.length s do while !i < String.length s do
@ -85,7 +94,10 @@ let parse_query s : (_ list, _) result=
) )
done; done;
Ok !pairs Ok !pairs
with e -> Error e with
| Invalid_argument _ | Not_found | Failure _ ->
Error (Printf.sprintf "error in parse_query for %S: i=%d,j=%d" s !i !j)
| Invalid_query -> Error ("invalid query string: " ^ s)
(*$= & ~printer:pp_res_query ~cmp:eq_sorted (*$= & ~printer:pp_res_query ~cmp:eq_sorted
(Ok ["a", "b"; "c", "d"]) (parse_query "a=b&c=d") (Ok ["a", "b"; "c", "d"]) (parse_query "a=b&c=d")

2
src/Tiny_httpd_util.mli
View file

@ -13,7 +13,7 @@ val percent_decode : string -> string option
(** Inverse operation of {!percent_encode}. (** Inverse operation of {!percent_encode}.
Can fail since some strings are not valid percent encodings. *) Can fail since some strings are not valid percent encodings. *)
val parse_query : string -> ((string*string) list, exn) result val parse_query : string -> ((string*string) list, string) result
(** Parse a query as a list of ['&'] or [';'] separated [key=value] pairs. (** Parse a query as a list of ['&'] or [';'] separated [key=value] pairs.
The order might not be preserved. The order might not be preserved.
@since 0.3 @since 0.3