diff --git a/src/Tiny_httpd_util.ml b/src/Tiny_httpd_util.ml new file mode 100644 index 00000000..80efcecb --- /dev/null +++ b/src/Tiny_httpd_util.ml @@ -0,0 +1,90 @@ +let percent_encode s = + let buf = Buffer.create (String.length s) in + String.iter + (function + | ' ' -> Buffer.add_string buf "%20" + | '!' -> Buffer.add_string buf "%21" + | '"' -> Buffer.add_string buf "%22" + | '#' -> Buffer.add_string buf "%23" + | '$' -> Buffer.add_string buf "%24" + | '%' -> Buffer.add_string buf "%25" + | '&' -> Buffer.add_string buf "%26" + | '\'' -> Buffer.add_string buf "%27" + | '(' -> Buffer.add_string buf "%28" + | ')' -> Buffer.add_string buf "%29" + | '*' -> Buffer.add_string buf "%2A" + | '+' -> Buffer.add_string buf "%2B" + | ',' -> Buffer.add_string buf "%2C" + | '/' -> Buffer.add_string buf "%2F" + | ':' -> Buffer.add_string buf "%3A" + | ';' -> Buffer.add_string buf "%3B" + | '=' -> Buffer.add_string buf "%3D" + | '?' -> Buffer.add_string buf "%3F" + | '@' -> Buffer.add_string buf "%40" + | '[' -> Buffer.add_string buf "%5B" + | ']' -> Buffer.add_string buf "%5D" + | c -> Buffer.add_char buf c) + s; + Buffer.contents buf + +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 ( + begin match String.sub s (!i+1) 2 with + | "20" -> Buffer.add_char buf ' ' + | "21" -> Buffer.add_char buf '!' + | "22" -> Buffer.add_char buf '"' + | "23" -> Buffer.add_char buf '#' + | "24" -> Buffer.add_char buf '$' + | "25" -> Buffer.add_char buf '%' + | "26" -> Buffer.add_char buf '&' + | "27" -> Buffer.add_char buf '\'' + | "28" -> Buffer.add_char buf '(' + | "29" -> Buffer.add_char buf ')' + | "2A" -> Buffer.add_char buf '*' + | "2B" -> Buffer.add_char buf '+' + | "2C" -> Buffer.add_char buf ',' + | "2F" -> Buffer.add_char buf '/' + | "3A" -> Buffer.add_char buf ':' + | "3B" -> Buffer.add_char buf ';' + | "3D" -> Buffer.add_char buf '=' + | "3F" -> Buffer.add_char buf '?' + | "40" -> Buffer.add_char buf '@' + | "5B" -> Buffer.add_char buf '[' + | "5D" -> Buffer.add_char buf ']' + | _ -> raise Exit + end; + i := !i + 3; + ) else ( + raise Exit (* truncated *) + ) + | c -> Buffer.add_char buf c; incr i + done; + Some (Buffer.contents buf) + with Exit -> None + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Tiny_httpd_util.mli b/src/Tiny_httpd_util.mli new file mode 100644 index 00000000..ab54263f --- /dev/null +++ b/src/Tiny_httpd_util.mli @@ -0,0 +1,13 @@ +(** {1 Some utils for writing web servers} + + @since NEXT_RELEASE +*) + +val percent_encode : string -> string +(** Encode the string into a valid path following + https://tools.ietf.org/html/rfc3986#section-2.1 +*) + +val percent_decode : string -> string option +(** Inverse operation of {!percent_encode}. + Can fail since some strings are not valid percent encodings. *) diff --git a/src/bin/http_of_dir.ml b/src/bin/http_of_dir.ml index bfb1ec95..475008a4 100644 --- a/src/bin/http_of_dir.ml +++ b/src/bin/http_of_dir.ml @@ -1,4 +1,5 @@ module S = Tiny_httpd +module U = Tiny_httpd_util module Pf = Printf type config = { @@ -38,8 +39,6 @@ let human_size (x:int) : string = let header_html = "Content-Type", "text/html" let (//) = Filename.concat -(* TODO: percent encoding/decoding *) - let html_list_dir ~top ~parent d : string = let entries = Sys.readdir @@ (top // d) in Array.sort compare entries; @@ -66,7 +65,7 @@ let html_list_dir ~top ~parent d : string = with _ -> "" in Printf.bprintf body "
  • %s %s%s
  • \n" - (d // f) f (if Sys.is_directory fpath then "[dir]" else "") size + (U.percent_encode (d // f)) f (if Sys.is_directory fpath then "[dir]" else "") size ); ) ) @@ -89,13 +88,15 @@ let serve ~config (dir:string) : _ result = if config.delete then ( S.add_path_handler server ~meth:`DELETE "/%s" (fun path _req -> - if contains_dot_dot path then ( + match U.percent_decode path with + | None -> S.Response.fail_raise ~code:404 "invalid percent encoding" + | Some path when contains_dot_dot path -> S.Response.fail_raise ~code:403 "invalid path in delete" - ); - S.Response.make_string - (try - Sys.remove (dir // path); Ok "file deleted successfully" - with e -> Error (500, Printexc.to_string e)) + | Some path -> + S.Response.make_string + (try + Sys.remove (dir // path); Ok "file deleted successfully" + with e -> Error (500, Printexc.to_string e)) ); ) else ( S.add_path_handler server ~meth:`DELETE "/%s" @@ -133,6 +134,10 @@ let serve ~config (dir:string) : _ result = ); S.add_path_handler server ~meth:`GET "/%s" (fun path req -> + let path = match U.percent_decode path with + | None -> S.Response.fail_raise ~code:404 "invalid path" + | Some p -> p + in let full_path = dir // path in let mtime = lazy ( try Printf.sprintf "mtime: %f" (Unix.stat full_path).Unix.st_mtime