1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
let is_file = Sys.file_exists
let is_directory k = is_file k && Sys.is_directory k
let concat = Filename.concat
let native = Fun.id
let get_requested_uri env reqd =
let request = H1.Reqd.request reqd in
let path = request.H1.Request.target in
let path =
if String.length path > 0 then String.sub path 1 (String.length path - 1)
else path
in
Yocaml_runtime.Server.Request_path.from_path ~is_file ~is_directory ~concat
~native env ~path
let file ?(status = `OK) reqd path =
let content_type = Yocaml_runtime.Server.Request_path.content_type path in
let ic = open_in path in
let len = in_channel_length ic in
let tmp = Bytes.create 0x7ff in
let =
H1.Headers.of_list
[ ("content-type", content_type); ("content-length", string_of_int len) ]
in
let resp = H1.Response.create ~headers status in
let body = H1.Reqd.respond_with_streaming reqd resp in
let rec go () =
let len = input ic tmp 0 (Bytes.length tmp) in
if len = 0 then (
close_in ic;
H1.Body.Writer.close body)
else (
H1.Body.Writer.write_string body (Bytes.sub_string tmp 0 len);
H1.Body.Writer.flush body go)
in
go ()
let render_html ?(status = `Not_found) reqd body =
let =
H1.Headers.of_list
[
("content-type", "text/html; charset=utf-8")
; ("content-length", string_of_int (String.length body))
]
in
let resp = H1.Response.create ~headers status in
H1.Reqd.respond_with_string reqd resp body
let error404 reqd htdoc =
let path = concat htdoc "404.html" in
if is_file path then file ~status:`Not_found reqd path
else render_html reqd (Yocaml_runtime.Server.Pages.error404 htdoc)
let dir reqd path lpath =
let index = concat path "index.html" in
if is_file index then file reqd index
else
let children =
path
|> Sys.readdir
|> Array.to_list
|> List.map
(Yocaml_runtime.Server.Kind.from_path ~is_directory ~concat path)
in
render_html reqd (Yocaml_runtime.Server.Pages.directory lpath children)
let[@warning "-8"] handler htdoc refresh _socket
(`V1 reqd : Httpcats.Server.reqd) =
let () = refresh () in
match get_requested_uri htdoc reqd with
| Error404 -> error404 reqd htdoc
| File (path, _) -> file reqd path
| Dir (path, lpath) -> dir reqd path lpath
let run ?custom_error_handler directory port program =
let refresh () = Runner.run ?custom_error_handler program in
let htdoc = Yocaml.Path.to_string directory in
let handler = handler htdoc refresh in
let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
Miou_unix.run ~domains:0 @@ fun () ->
Yocaml_runtime.Server.prompt port;
Httpcats.Server.clear ~handler sockaddr