Fix terribly broken escaping.

html.ml

@@ -40,23 +40,20 @@ let tag_of_document doc =
 	@ doc.html_headers);
      tag "body" [] doc.html_body]
 
-let html_escape_re = Str.regexp "[&<>]"
+let escape_html_char c =
-let escape_html_char s =
+  match c with
-  match s with
+  | '&' -> Some (fun (s, pos) -> ("&amp;", pos + 1))
-  | "&" -> "&amp;"
+  | '<' -> Some (fun (s, pos) -> ("&lt;", pos + 1))
-  | "<" -> "&lt;"
+  | '>' -> Some (fun (s, pos) -> ("&gt;", pos + 1))
-  | ">" -> "&gt;"
+  | _ -> None
-  | _ -> failwith ("Unexpected HTML char to escape: " ^ s)
+let html_escape s = Util.strsub escape_html_char s
-let html_escape s = Str.global_substitute html_escape_re escape_html_char s
 
-let html_attribute_escape_re = Str.regexp "['\"]"
+let escape_html_attribute_char c =
-let escape_html_attribute_char s =
+  match c with
-  match s with
+  | '\'' -> Some (fun (s, pos) -> ("&apos;", pos + 1))
-  | "'" -> "&apos;"
+  | '\"' -> Some (fun (s, pos) -> ("&quot;", pos + 1))
-  | "\"" -> "&quot;"
+  | _ -> None
-  | _ -> failwith ("Unexpected HTML attribute char to escape: " ^ s)
+let html_attribute_escape s = Util.strsub escape_html_attribute_char s
-let html_attribute_escape s =
-  Str.global_substitute html_attribute_escape_re escape_html_attribute_char s
 
 let string_of_html_attribute (k, v) =
   k ^ "=\"" ^ html_attribute_escape v ^ "\""

httpd.ml

@@ -109,20 +109,19 @@ let resp_redirect_permanent new_path =
 	Html.tag "a" ["href", new_path] [Html.text "here"];
 	Html.text "."])
 
-let url_escape_re = Str.regexp "[% ]"
+let escape_url_char c =
-let escape_url_char s =
+  match c with
-  match s with
+  | '%' -> Some (fun (s, pos) -> ("%25", pos + 1))
-  | "%" -> "%25"
+  | ' ' -> Some (fun (s, pos) -> ("%20", pos + 1))
-  | " " -> "%20"
+  | _ -> None
-  | _ -> failwith ("Unexpected URL char to escape: " ^ s)
+let url_escape s = Util.strsub escape_url_char s
-let url_escape s = Str.global_substitute url_escape_re escape_url_char s
 
 let unhex_char c =
   match c with
   | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' -> Char.code c - Char.code '0'
-  | 'a' | 'b' | 'c' | 'd' | 'e' | 'f' -> Char.code c - Char.code 'a'
+  | 'a' | 'b' | 'c' | 'd' | 'e' | 'f' -> Char.code c - Char.code 'a' + 10
-  | 'A' | 'B' | 'C' | 'D' | 'E' | 'F' -> Char.code c - Char.code 'A'
+  | 'A' | 'B' | 'C' | 'D' | 'E' | 'F' -> Char.code c - Char.code 'A' + 10
-  | _ -> 0
+  | _ -> -1
 
 let unhex s =
   let len = String.length s in
@@ -133,10 +132,23 @@ let unhex s =
   in
   loop 0 0
 
-let url_unescape_re = Str.regexp "%[0-9a-zA-Z][0-9a-zA-Z]"
+let unescape_url_hex_code (s, pos) =
-let unescape_url_char s =
+  let len = String.length s in
-  String.make 1 (Char.chr (unhex_char (String.get s 1) * 16 + unhex_char (String.get s 2)))
+  if len - pos >= 3
-let url_unescape s = Str.global_substitute url_unescape_re unescape_url_char s
+  then
+    let v1 = unhex_char (String.get s (pos + 1)) in
+    let v2 = unhex_char (String.get s (pos + 2)) in
+    if v1 = -1 || v2 = -1
+    then http_error_html 400 ("Bad percent escaping: '"^String.sub s pos 3^"'") []
+    else (String.make 1 (Char.chr (v1 * 16 + v2)), pos + 3)
+  else http_error_html 400 ("Bad percent escaping: '"^String.sub s pos (len - pos)^"'") []
+
+let unescape_url_char c =
+  match c with
+  | '%' -> Some unescape_url_hex_code
+  | _ -> None
+
+let url_unescape s = Util.strsub unescape_url_char s
 
 let render_header cout (k, v) =
   output_string cout k;

json.ml

@@ -23,12 +23,11 @@ type t =
   | Flg of bool
   | Nil
 
-let escape_re = Str.regexp "\""
+let escape_char c =
-let escape_char s =
+  match c with
-  match s with
+  | '\"' -> Some (fun (s, pos) -> ("\\\"", pos + 1))
-  | "\"" -> "\\\""
+  | _ -> None
-  | _ -> failwith ("Unexpected JSON char to escape: " ^ s)
+let escape s = Util.strsub escape_char s
-let escape s = Str.global_substitute escape_re escape_char s
 
 let str_to_string s =
   "\"" ^ escape s ^ "\""

util.ml

@@ -59,3 +59,21 @@ let strip s =
   let l = left 0 in
   let r = 1 + right (len - 1) in
   if r <= l then "" else String.sub s l (r - l)
+
+let strsub replacement_fn s =
+  let len = String.length s in
+  let finish_span low high acc = String.sub s low (high - low) :: acc in
+  let finish acc = String.concat "" (List.rev acc) in
+  let rec outer_loop acc low =
+    let rec inner_loop high =
+      if high = len
+      then finish (finish_span low high acc)
+      else
+	match replacement_fn (String.get s high) with
+	| Some handler ->
+	    let (replacement, new_low) = handler (s, high) in
+	    outer_loop (replacement :: finish_span low high acc) new_low
+	| None ->
+	    inner_loop (high + 1)
+    in inner_loop low
+  in outer_loop [] 0