tiny_httpd/src/Tiny_httpd_util.ml

let percent_encode ?(skip = fun _ -> false) s =
  let buf = Buffer.create (String.length s) in
  String.iter
    (function
      | c when skip c -> Buffer.add_char buf c
      | ( ' ' | '!' | '"' | '#' | '$' | '%' | '&' | '\'' | '(' | ')' | '*' | '+'
        | ',' | '/' | ':' | ';' | '=' | '?' | '@' | '[' | ']' | '~' ) as c ->
        Printf.bprintf buf "%%%X" (Char.code c)
      | c when Char.code c > 127 -> Printf.bprintf buf "%%%X" (Char.code c)
      | c -> Buffer.add_char buf c)
    s;
  Buffer.contents buf

let hex_int (s : string) : int = Scanf.sscanf s "%x" (fun x -> x)

let percent_decode (s : string) : _ option =
  let buf = Buffer.create (String.length s) in
  let i = ref 0 in
  try
    while !i < String.length s do
      match String.get s !i with
      | '%' ->
        if !i + 2 < String.length s then (
          (match hex_int @@ String.sub s (!i + 1) 2 with
          | n -> Buffer.add_char buf (Char.chr n)
          | exception _ -> raise Exit);
          i := !i + 3
        ) else
          raise Exit (* truncated *)
      | '+' ->
        Buffer.add_char buf ' ';
        incr i (* for query strings *)
      | c ->
        Buffer.add_char buf c;
        incr i
    done;
    Some (Buffer.contents buf)
  with Exit -> None

exception Invalid_query

let find_q_index_ s = String.index s '?'

let get_non_query_path s =
  match find_q_index_ s with
  | i -> String.sub s 0 i
  | exception Not_found -> s

let get_query s : string =
  match find_q_index_ s with
  | i -> String.sub s (i + 1) (String.length s - i - 1)
  | exception Not_found -> ""

let split_query s = get_non_query_path s, get_query s

let split_on_slash s : _ list =
  let l = ref [] in
  let i = ref 0 in
  let n = String.length s in
  while !i < n do
    match String.index_from s !i '/' with
    | exception Not_found ->
      if !i < n then (* last component *) l := String.sub s !i (n - !i) :: !l;
      i := n (* done *)
    | j ->
      if j > !i then l := String.sub s !i (j - !i) :: !l;
      i := j + 1
  done;
  List.rev !l

let parse_query s : (_ list, string) result =
  let pairs = ref [] in
  let is_sep_ = function
    | '&' | ';' -> true
    | _ -> false
  in
  let i = 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 eq = String.index_from s !i '=' in
      let k = percent_decode @@ String.sub s !i (eq - !i) in
      let v = percent_decode @@ String.sub s (eq + 1) (!j - eq - 1) in
      pairs := (k, v) :: !pairs
    in
    while !i < String.length s do
      while !j < String.length s && not (is_sep_ (String.get s !j)) do
        incr j
      done;
      if !j < String.length s then (
        assert (is_sep_ (String.get s !j));
        parse_pair ();
        i := !j + 1;
        j := !i
      ) else (
        parse_pair ();
        i := String.length s (* done *)
      )
    done;
    Ok !pairs
  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)