feat: add rest_of_path_urlencoded and rename rest to rest_of_path

Author: c-cube

src/Tiny_httpd.ml

@@ -688,11 +688,14 @@ module Route = struct
 
   type (_, _) t =
     | Fire : ('b, 'b) t
-    | Rest : (string -> 'b, 'b) t
+    | Rest : {
+        url_encoded: bool;
+      } -> (string -> 'b, 'b) t
     | Compose: ('a, 'b) comp * ('b, 'c) t -> ('a, 'c) t
 
   let return = Fire
-  let rest = Rest
+  let rest_of_path = Rest {url_encoded=false}
+  let rest_of_path_urlencoded = Rest {url_encoded=true}
   let (@/) a b = Compose (a,b)
   let string = String
   let string_urlencoded = String_urlencoded
@@ -705,9 +708,19 @@ module Route = struct
     begin match path, route with
       | [], Fire -> Some f
       | _, Fire -> None
-      | _, Rest ->
+      | _, Rest {url_encoded} ->
         let whole_path = String.concat "/" path in
-        Some (f whole_path)
+        begin match
+            if url_encoded
+            then match Tiny_httpd_util.percent_decode whole_path with
+              | Some s -> s
+              | None -> raise_notrace Exit
+            else whole_path
+          with
+          | whole_path ->
+            Some (f whole_path)
+          | exception Exit -> None
+        end
       | (c1 :: path'), Compose (comp, route') ->
         begin match comp with
           | Int ->
@@ -735,7 +748,8 @@ module Route = struct
     : type a b. Buffer.t -> (a,b) t -> unit
     = fun out -> function
       | Fire -> bpf out "/"
-      | Rest -> bpf out "<rest>"
+      | Rest {url_encoded} ->
+        bpf out "<rest_of_url%s>" (if url_encoded then "_urlencoded" else "")
       | Compose (Exact s, tl) -> bpf out "%s/%a" s pp_ tl
       | Compose (Int, tl) -> bpf out "<int>/%a" pp_ tl
       | Compose (String, tl) -> bpf out "<str>/%a" pp_ tl

src/Tiny_httpd.mli

@@ -397,11 +397,16 @@ module Route : sig
   val return : ('a, 'a) t
   (** Matches the empty path. *)
 
-  val rest : (string -> 'a, 'a) t
+  val rest_of_path : (string -> 'a, 'a) t
   (** Matches a string, even containing ['/']. This will match
       the entirety of the remaining route.
       @since NEXT_RELEASE *)
 
+  val rest_of_path_urlencoded : (string -> 'a, 'a) t
+  (** Matches a string, even containing ['/'], an URL-decode it.
+      This will match the entirety of the remaining route.
+      @since NEXT_RELEASE *)
+
   val (@/) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
   (** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"],
       and [route] matches ["bar/…"]. *)

src/bin/http_of_dir.ml

@@ -116,9 +116,8 @@ let serve ~config (dir:string) : _ result =
     dir (if S.is_ipv6 server then "[%s]" else "%s") config.addr config.port;
   if config.delete then (
     S.add_route_handler server ~meth:`DELETE
-      S.Route.rest
+      S.Route.rest_of_path_urlencoded
       (fun path _req ->
-         let path = decode_path path in
          if contains_dot_dot path then (
            S.Response.fail_raise ~code:403 "invalid path in delete"
          ) else (
@@ -135,7 +134,7 @@ let serve ~config (dir:string) : _ result =
   );
   if config.upload then (
     S.add_route_handler_stream server ~meth:`PUT
-      S.Route.rest
+      S.Route.rest_of_path_urlencoded
       ~accept:(fun req ->
           match S.Request.get_header_int req "Content-Length" with
           | Some n when n > config.max_upload_size ->
@@ -145,7 +144,6 @@ let serve ~config (dir:string) : _ result =
           | _ -> Ok ()
         )
       (fun path req ->
-         let path = decode_path path in
          let fpath = dir // path in
          let oc =
            try open_out fpath
@@ -166,9 +164,8 @@ let serve ~config (dir:string) : _ result =
       (fun _ _  -> S.Response.make_raw ~code:405 "upload not allowed");
   );
   S.add_route_handler server ~meth:`GET
-    S.Route.rest
+    S.Route.rest_of_path_urlencoded
     (fun path req ->
-       let path = decode_path path in
        let full_path = dir // path in
        let mtime = lazy (
          try Printf.sprintf "mtime: %f" (Unix.stat full_path).Unix.st_mtime