106 lines
3.5 KiB
OCaml
106 lines
3.5 KiB
OCaml
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
|
|
|
(* This file is part of Hop. *)
|
|
|
|
(* Hop is free software: you can redistribute it and/or modify it *)
|
|
(* under the terms of the GNU General Public License as published by the *)
|
|
(* Free Software Foundation, either version 3 of the License, or (at your *)
|
|
(* option) any later version. *)
|
|
|
|
(* Hop is distributed in the hope that it will be useful, but *)
|
|
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
|
|
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
|
|
(* General Public License for more details. *)
|
|
|
|
(* You should have received a copy of the GNU General Public License *)
|
|
(* along with Hop. If not, see <http://www.gnu.org/licenses/>. *)
|
|
|
|
open Lwt
|
|
open Hof
|
|
|
|
let visible_path_component s =
|
|
match s with
|
|
| "" -> false
|
|
| "." -> false
|
|
| ".." -> false
|
|
| _ -> if String.get s 0 = '.' then false else true
|
|
|
|
let sanitize_path_re = Str.regexp "/"
|
|
let sanitize_path p =
|
|
String.concat "/" (List.filter visible_path_component (Str.split sanitize_path_re p))
|
|
|
|
let extension_map ext =
|
|
match String.lowercase_ascii ext with
|
|
| ".txt" -> Httpd.text_content_type
|
|
| ".html" | ".htm" -> Httpd.html_content_type
|
|
| ".bin" -> "application/octet-stream"
|
|
| ".jpg" | ".jpeg" -> "image/jpeg"
|
|
| ".gif" -> "image/gif"
|
|
| ".png" -> "image/png"
|
|
| ".css" -> "text/css"
|
|
| ".js" -> "text/javascript"
|
|
| ".json" -> "application/json"
|
|
| _ -> "application/octet-stream"
|
|
|
|
let analyze_path p =
|
|
let p = sanitize_path p in
|
|
let chopped_p = (try Filename.chop_extension p with _ -> p) in
|
|
let ext = String.sub p (String.length chopped_p) (String.length p - String.length chopped_p) in
|
|
let p = if p = "" then "." else p in
|
|
(p, extension_map ext)
|
|
|
|
let stream_file handle =
|
|
let buflen = 4096 in
|
|
let buffer = Bytes.make buflen '\000' in
|
|
fun () ->
|
|
let count = input handle buffer 0 buflen in
|
|
if count > 0
|
|
then return (Some (Bytes.sub buffer 0 count))
|
|
else return None
|
|
|
|
let rec read_dir dirhandle =
|
|
try
|
|
let n = Unix.readdir dirhandle in
|
|
n :: read_dir dirhandle
|
|
with End_of_file ->
|
|
[]
|
|
|
|
let render_directory_listing path =
|
|
let dir = Unix.opendir path in
|
|
let entries = List.filter visible_path_component (read_dir dir) in
|
|
Unix.closedir dir;
|
|
Html.html_document path []
|
|
[Html.tag "h1" [] [Html.text "Directory listing for "; Html.tag "tt" [] [Html.text path]];
|
|
Html.tag "ul" []
|
|
(List.map
|
|
(fun e -> Html.tag "li" [] [Html.tag "a" ["href", e] [Html.text e]])
|
|
entries);
|
|
Html.unclosed_tag "hr" [] []]
|
|
|
|
let resp_raw_file mime_type path =
|
|
let handle = open_in_bin path in
|
|
Httpd.resp_generic_ok
|
|
[Httpd.content_type_header_name, mime_type]
|
|
(Httpd.Variable (Lwt_stream.from (stream_file handle)))
|
|
|> Httpd.add_completion_callback (fun () -> close_in handle; return ())
|
|
|
|
let resp_file raw_path =
|
|
let (path, mime_type) = analyze_path raw_path in
|
|
(try
|
|
(if Sys.is_directory path
|
|
then
|
|
let maybe_index_html = Filename.concat path "index.html" in
|
|
if Sys.file_exists maybe_index_html && not (Sys.is_directory maybe_index_html)
|
|
then resp_raw_file Httpd.html_content_type maybe_index_html
|
|
else
|
|
if path = "." || Str.last_chars raw_path 1 = "/"
|
|
then Httpd.resp_html_doc_ok [] (render_directory_listing path)
|
|
else Httpd.resp_redirect_permanent ("/"^path^"/")
|
|
else if Sys.file_exists path
|
|
then
|
|
resp_raw_file mime_type path
|
|
else
|
|
Httpd.http_error_html 404 "Not found" [])
|
|
with Sys_error message ->
|
|
Httpd.http_error_html 403 "Forbidden" [Html.text message])
|