From fdff96ccfe37e1d5829e8d7a6d0ce537a4c42f6d Mon Sep 17 00:00:00 2001 From: Samuel Hym Date: Fri, 29 Nov 2024 19:32:15 +0100 Subject: [PATCH] Add support for directory listings in `Staticmod` Add a simple generator for directory listings: - the listings are unstyled - the generation must load the full directory (so that the entries can be sorted) - consequently the generation should probably not be enabled when there are huge directories (which are usually a bad idea anyhow) --- src/extensions/staticmod.ml | 96 ++++++++++++++++++++++++++++++++----- 1 file changed, 85 insertions(+), 11 deletions(-) diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index a6af87930..135759215 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -116,6 +116,82 @@ let find_static_page ~request ~usermode ~dir ~(err : Cohttp.Code.status) (Ocsigen_extensions.Error_in_user_config_file "Staticmod: cannot use '..' in user paths") +(* Borrowed from TyXML:lib/xml_print.ml (and wrapped) to avoid the dependency *) +let html_of_string s = + let is_control c = + let cc = Char.code c in + cc <= 8 || cc = 11 || cc = 12 || (14 <= cc && cc <= 31) || cc = 127 + in + let add_unsafe_char b = function + | '<' -> Buffer.add_string b "<" + | '>' -> Buffer.add_string b ">" + | '"' -> Buffer.add_string b """ + | '&' -> Buffer.add_string b "&" + | c when is_control c -> + Buffer.add_string b "&#"; + Buffer.add_string b (string_of_int (Char.code c)); + Buffer.add_string b ";" + | c -> Buffer.add_char b c + in + let encode_unsafe_char s = + let b = Buffer.create (String.length s) in + String.iter (add_unsafe_char b) s; + Buffer.contents b + in + encode_unsafe_char s +(* End of borrowed code *) + +let respond_dir relpath dname : (Cohttp.Response.t * Cohttp_lwt.Body.t) Lwt.t = + let readsortdir = + (* Read a complete directory and sort its entries *) + let chunk_size = 1024 in + let rec aux entries dir = + Lwt_unix.readdir_n dir chunk_size >>= fun chunk -> + let entries = chunk :: entries in + if Array.length chunk < chunk_size + then Lwt.return entries + else aux entries dir + in + Lwt_unix.opendir dname >>= fun dir -> + Lwt.finalize + (fun () -> + aux [] dir >|= fun entries -> + List.sort compare (List.concat_map Array.to_list entries)) + (fun () -> Lwt_unix.closedir dir) + in + Lwt.catch + (fun () -> + readsortdir >>= fun entries -> + let title = html_of_string ("Directory listing for /" ^ relpath) in + let entries = + List.filter_map + (function + | "." | ".." -> None + | e -> + Some + (Printf.sprintf "
  • %t
    • " + (fun () -> Ocsigen_lib.Url.encode ~plus:false e) + (fun () -> html_of_string e))) + entries + in + (* Chunks of [html (head (title x) []) (body [h1 [x]; ul y])] *) + let chunk1 = + {| +|} + and chunk2 = {|

    |} + and chunk3 = {|

    |} in + let doc = + chunk1 :: title :: chunk2 :: title :: chunk3 :: (entries @ [chunkend]) + in + let headers = Cohttp.Header.init_with "content-type" "text/html" in + Lwt.return + ( Cohttp.Response.make ~status:`OK ~headers () + , Cohttp_lwt.Body.of_string_list doc )) + (function + | Unix.Unix_error _ -> Cohttp_lwt_unix.Server.respond_not_found () + | exn -> Lwt.fail exn) + let gen ~usermode ?cache dir = function | Ocsigen_extensions.Req_found _ -> Lwt.return Ocsigen_extensions.Ext_do_nothing @@ -123,20 +199,18 @@ let gen ~usermode ?cache dir = function (err, ({Ocsigen_extensions.request_info; _} as request)) -> let try_block () = Lwt_log.ign_info ~section "Is it a static file?"; + let pathstring = + Ocsigen_lib.Url.string_of_url_path ~encode:false + (Ocsigen_request.sub_path request_info) + in let status_filter, page = - let pathstring = - Ocsigen_lib.Url.string_of_url_path ~encode:false - (Ocsigen_request.sub_path request_info) - in find_static_page ~request ~usermode ~dir ~err ~pathstring in - let fname = - match page with - | Ocsigen_local_files.RFile fname -> fname - | Ocsigen_local_files.RDir _ -> - failwith "FIXME: staticmod dirs not implemented" - in - Cohttp_lwt_unix.Server.respond_file ~fname () >>= fun answer -> + (match page with + | Ocsigen_local_files.RFile fname -> + Cohttp_lwt_unix.Server.respond_file ~fname () + | Ocsigen_local_files.RDir dname -> respond_dir pathstring dname) + >>= fun answer -> let answer = Ocsigen_response.of_cohttp answer in let answer = if not status_filter