Web UI
This commit is contained in:
Tony Garnock-Jones
parent
ac7541e571
commit
e968d78fc4
|
|
@ -0,0 +1,98 @@
|
|||
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
||||
|
||||
(* This file is part of Ocamlmsg. *)
|
||||
|
||||
(* Ocamlmsg 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. *)
|
||||
|
||||
(* Ocamlmsg 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 Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
|
||||
|
||||
type html_content =
|
||||
| Tag of string * (string * string) list * html_content list * bool
|
||||
| Text of string
|
||||
|
||||
type html_document = {
|
||||
html_title: string;
|
||||
html_headers: html_content list;
|
||||
html_body: html_content list
|
||||
}
|
||||
|
||||
let html_document title headers body =
|
||||
{html_title = title; html_headers = headers; html_body = body}
|
||||
|
||||
let tag label attrs contents = Tag (label, attrs, contents, false)
|
||||
let unclosed_tag label attrs contents = Tag (label, attrs, contents, true)
|
||||
let text str = Text str
|
||||
|
||||
let tag_of_document doc =
|
||||
tag "html" []
|
||||
[tag "head" []
|
||||
([unclosed_tag "meta" ["charset", "utf-8"] [];
|
||||
tag "title" [] [text doc.html_title]]
|
||||
@ doc.html_headers);
|
||||
tag "body" [] doc.html_body]
|
||||
|
||||
let html_escape_re = Str.regexp "[&<>]"
|
||||
let escape_html_char s =
|
||||
match s with
|
||||
| "&" -> "&"
|
||||
| "<" -> "<"
|
||||
| ">" -> ">"
|
||||
| _ -> failwith ("Unexpected HTML char to escape: " ^ s)
|
||||
let html_escape s = Str.global_substitute html_escape_re escape_html_char s
|
||||
|
||||
let html_attribute_escape_re = Str.regexp "['\"]"
|
||||
let escape_html_attribute_char s =
|
||||
match s with
|
||||
| "'" -> "'"
|
||||
| "\"" -> """
|
||||
| _ -> failwith ("Unexpected HTML attribute char to escape: " ^ s)
|
||||
let html_attribute_escape s =
|
||||
Str.global_substitute html_attribute_escape_re escape_html_attribute_char s
|
||||
|
||||
let string_of_html_attribute (k, v) =
|
||||
k ^ "=\"" ^ html_attribute_escape v ^ "\""
|
||||
|
||||
let string_of_html_attributes attrs =
|
||||
String.concat " " (List.map string_of_html_attribute attrs)
|
||||
|
||||
let html_open_tag_string label attrs =
|
||||
match attrs with
|
||||
| [] ->
|
||||
"<" ^ label ^ ">"
|
||||
| _ ->
|
||||
"<" ^ label ^ " " ^ string_of_html_attributes attrs ^ ">"
|
||||
|
||||
let rec string_of_html_contents cs = String.concat "" (List.map string_of_html cs)
|
||||
and string_of_html c =
|
||||
match c with
|
||||
| Tag (label, attrs, [], true) ->
|
||||
html_open_tag_string label attrs
|
||||
| Tag (label, attrs, contents, _) ->
|
||||
html_open_tag_string label attrs ^ string_of_html_contents contents ^ "</" ^ label ^ ">"
|
||||
| Text str ->
|
||||
html_escape str
|
||||
|
||||
let rec stream_of_html_contents cs = Stringstream.map stream_of_html cs
|
||||
and stream_of_html c =
|
||||
Stringstream.make (fun () ->
|
||||
match c with
|
||||
| Tag (label, attrs, [], true) ->
|
||||
Some (html_open_tag_string label attrs, Stringstream.empty)
|
||||
| Tag (label, attrs, contents, _) ->
|
||||
Some (html_open_tag_string label attrs,
|
||||
Stringstream.seq
|
||||
(stream_of_html_contents contents) (Stringstream.const ("</"^label^">")))
|
||||
| Text str ->
|
||||
Some (str, Stringstream.empty))
|
||||
|
||||
let stream_of_html_doc d =
|
||||
Stringstream.seq (Stringstream.const "<!DOCTYPE html>") (stream_of_html (tag_of_document d))
|
||||
|
|
@ -0,0 +1,227 @@
|
|||
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
||||
|
||||
(* This file is part of Ocamlmsg. *)
|
||||
|
||||
(* Ocamlmsg 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. *)
|
||||
|
||||
(* Ocamlmsg 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 Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
|
||||
|
||||
open Unix
|
||||
|
||||
type version = [`HTTP_1_0 | `HTTP_1_1]
|
||||
type resp_version = [version | `SAME_AS_REQUEST]
|
||||
type content = Fixed of string | Variable of Stringstream.t
|
||||
|
||||
type body = {
|
||||
headers: (string * string) list;
|
||||
content: content
|
||||
}
|
||||
|
||||
let empty_body = {headers = []; content = Fixed ""}
|
||||
|
||||
type req = {
|
||||
verb: string;
|
||||
path: string;
|
||||
query: string;
|
||||
req_version: version;
|
||||
req_body: body
|
||||
}
|
||||
|
||||
type resp = {
|
||||
resp_version: resp_version;
|
||||
status: int;
|
||||
reason: string;
|
||||
resp_body: body
|
||||
}
|
||||
|
||||
exception HTTPError of (int * string * body)
|
||||
|
||||
let html_content_type = "text/html;charset=utf-8"
|
||||
let text_content_type = "text/plain;charset=utf-8"
|
||||
|
||||
let content_type_header_name = "Content-Type"
|
||||
|
||||
let html_content_type_header = (content_type_header_name, html_content_type)
|
||||
let text_content_type_header = (content_type_header_name, text_content_type)
|
||||
|
||||
let http_error code reason body = raise (HTTPError (code, reason, body))
|
||||
|
||||
let http_error_plain code reason =
|
||||
http_error code reason
|
||||
{headers = [text_content_type_header]; content = Fixed reason}
|
||||
|
||||
let http_error_html_doc code reason doc =
|
||||
http_error code reason
|
||||
{headers = [html_content_type_header];
|
||||
content = Variable (Html.stream_of_html_doc doc)}
|
||||
|
||||
let html_error_doc code reason extra_body =
|
||||
let code_str = string_of_int code in
|
||||
(Html.html_document (code_str^" "^reason) []
|
||||
((Html.tag "h1" [] [Html.text reason]) :: extra_body))
|
||||
|
||||
let http_error_html code reason extra_body =
|
||||
http_error_html_doc code reason (html_error_doc code reason extra_body)
|
||||
|
||||
let resp_generic code reason headers content =
|
||||
{ resp_version = `SAME_AS_REQUEST;
|
||||
status = code;
|
||||
reason = reason;
|
||||
resp_body = {headers = headers; content = content} }
|
||||
|
||||
let resp_generic_ok headers content =
|
||||
resp_generic 200 "OK" headers content
|
||||
|
||||
let resp_html_doc code reason extra_headers doc =
|
||||
resp_generic code reason
|
||||
(html_content_type_header :: extra_headers)
|
||||
(Variable (Html.stream_of_html_doc doc))
|
||||
|
||||
let resp_html_doc_ok extra_headers doc = resp_html_doc 200 "OK" extra_headers doc
|
||||
|
||||
let resp_html code reason extra_headers title content =
|
||||
resp_html_doc code reason extra_headers (Html.html_document title [] content)
|
||||
|
||||
let resp_html_ok extra_headers title content =
|
||||
resp_html 200 "OK" extra_headers title content
|
||||
|
||||
let resp_redirect_permanent new_path =
|
||||
resp_html_doc 301 "Moved permanently" ["Location", new_path]
|
||||
(html_error_doc 301 "Moved permanently"
|
||||
[Html.text "The document has moved ";
|
||||
Html.tag "a" ["href", new_path] [Html.text "here"];
|
||||
Html.text "."])
|
||||
|
||||
let url_escape_re = Str.regexp "[% ]"
|
||||
let escape_url_char s =
|
||||
match s with
|
||||
| "%" -> "%25"
|
||||
| " " -> "%20"
|
||||
| _ -> failwith ("Unexpected URL char to escape: " ^ s)
|
||||
let url_escape s = Str.global_substitute url_escape_re escape_url_char s
|
||||
|
||||
let url_unescape_re = Str.regexp "%[0-9a-zA-Z][0-9a-zA-Z]"
|
||||
let unhex_char c =
|
||||
match c with
|
||||
| '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' -> Char.code c - Char.code '0'
|
||||
| 'a' | 'b' | 'c' | 'd' | 'e' | 'f' -> Char.code c - Char.code 'a'
|
||||
| 'A' | 'B' | 'C' | 'D' | 'E' | 'F' -> Char.code c - Char.code 'A'
|
||||
| _ -> 0
|
||||
let unescape_url_char s =
|
||||
String.make 1 (Char.chr (unhex_char (String.get s 1) * 16 + unhex_char (String.get s 2)))
|
||||
let url_unescape s = Str.global_substitute url_unescape_re unescape_url_char s
|
||||
|
||||
let render_header cout (k, v) =
|
||||
output_string cout k;
|
||||
output_string cout ": ";
|
||||
output_string cout v;
|
||||
output_string cout "\r\n"
|
||||
|
||||
let render_chunk cout chunk =
|
||||
match chunk with
|
||||
| "" -> ()
|
||||
| _ ->
|
||||
output_string cout (Printf.sprintf "%x\r\n" (String.length chunk));
|
||||
output_string cout chunk;
|
||||
output_string cout "\r\n"
|
||||
|
||||
let render_fixed_content cout s =
|
||||
render_header cout ("Content-Length", string_of_int (String.length s));
|
||||
output_string cout "\r\n";
|
||||
output_string cout s
|
||||
|
||||
let render_content cout v c =
|
||||
match c with
|
||||
| Fixed s ->
|
||||
render_fixed_content cout s
|
||||
| Variable s ->
|
||||
match v with
|
||||
| `HTTP_1_0 ->
|
||||
render_fixed_content cout (Stringstream.to_string s)
|
||||
| `HTTP_1_1 ->
|
||||
render_header cout ("Transfer-Encoding", "chunked");
|
||||
output_string cout "\r\n";
|
||||
Stringstream.iter (render_chunk cout) s;
|
||||
output_string cout "0\r\n\r\n"
|
||||
|
||||
let render_body cout v b =
|
||||
List.iter (render_header cout) b.headers;
|
||||
render_content cout v b.content
|
||||
|
||||
let string_of_version v =
|
||||
match v with
|
||||
| `HTTP_1_0 -> "HTTP/1.0"
|
||||
| `HTTP_1_1 -> "HTTP/1.1"
|
||||
|
||||
let version_of_string v =
|
||||
match v with
|
||||
| "HTTP/1.0" -> `HTTP_1_0
|
||||
| "HTTP/1.1" -> `HTTP_1_1
|
||||
| _ -> http_error_html 400 "Invalid HTTP version" []
|
||||
|
||||
let render_req cout r =
|
||||
output_string cout (r.verb^" "^url_escape r.path^" "^string_of_version r.req_version^"\r\n");
|
||||
render_body cout r.req_version r.req_body
|
||||
|
||||
let render_resp cout req_version r =
|
||||
let resp_version =
|
||||
(match r.resp_version with
|
||||
| `SAME_AS_REQUEST -> req_version
|
||||
| #version as v -> v)
|
||||
in
|
||||
output_string cout
|
||||
(string_of_version resp_version^" "^string_of_int r.status^" "^r.reason^"\r\n");
|
||||
render_body cout resp_version r.resp_body
|
||||
|
||||
let split_query p =
|
||||
match Str.bounded_split (Str.regexp "\\?") p 2 with
|
||||
| path :: query :: _ -> (path, query)
|
||||
| path :: [] -> (path, "")
|
||||
| [] -> ("", "")
|
||||
|
||||
let parse_body cin = empty_body
|
||||
|
||||
let input_crlf cin =
|
||||
let line = input_line cin in
|
||||
let len = String.length line in
|
||||
if len > 0 && String.get line (len - 1) = '\r'
|
||||
then String.sub line 0 (len - 1)
|
||||
else line
|
||||
|
||||
let rec parse_req cin spurious_newline_credit =
|
||||
match Str.bounded_split (Str.regexp " ") (input_crlf cin) 3 with
|
||||
| [] ->
|
||||
(* HTTP spec requires that we ignore leading CRLFs. We choose to do so, up to a point. *)
|
||||
if spurious_newline_credit = 0
|
||||
then http_error_html 400 "Bad request: too many leading CRLFs" []
|
||||
else parse_req cin (spurious_newline_credit - 1)
|
||||
| [verb; path; version_str] ->
|
||||
let version = version_of_string version_str in
|
||||
let body = parse_body cin in
|
||||
let path = url_unescape path in
|
||||
let (path, query) = split_query path in
|
||||
{ verb = verb; path = path; query = query; req_version = version; req_body = body }
|
||||
| _ -> http_error_html 400 "Bad request line" []
|
||||
|
||||
let main handle_req (s, peername) =
|
||||
let cin = in_channel_of_descr s in
|
||||
let cout = out_channel_of_descr s in
|
||||
(try
|
||||
(try
|
||||
let req = parse_req cin 512 in
|
||||
render_resp cout req.req_version (handle_req req)
|
||||
with HTTPError (code, reason, body) ->
|
||||
render_resp cout `HTTP_1_0
|
||||
{ resp_version = `HTTP_1_0; status = code; reason = reason; resp_body = body })
|
||||
with _ -> ());
|
||||
(try flush cout with _ -> ());
|
||||
close s
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
||||
|
||||
(* This file is part of Ocamlmsg. *)
|
||||
|
||||
(* Ocamlmsg 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. *)
|
||||
|
||||
(* Ocamlmsg 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 Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
|
||||
|
||||
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 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 read_and_close_file handle =
|
||||
let buflen = 4096 in
|
||||
let buffer = String.make buflen '\000' in
|
||||
fun () ->
|
||||
let count =
|
||||
(try
|
||||
input handle buffer 0 buflen
|
||||
with e -> (close_in handle; raise e))
|
||||
in
|
||||
if count > 0
|
||||
then Some (String.sub buffer 0 count)
|
||||
else (close_in handle;
|
||||
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 =
|
||||
Httpd.resp_generic_ok
|
||||
[Httpd.content_type_header_name, mime_type]
|
||||
(Httpd.Variable (Stringstream.from_iter (read_and_close_file (open_in_bin path))))
|
||||
|
||||
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])
|
||||
|
|
@ -35,5 +35,6 @@ let _ =
|
|||
Meta.init ();
|
||||
hook_log ();
|
||||
Amqp_relay.init ();
|
||||
Ui_main.init ();
|
||||
(* Speedtest.init (); *)
|
||||
Net.start_net "Hop" 5671 Relay.start
|
||||
|
|
|
|||
|
|
@ -0,0 +1,70 @@
|
|||
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
||||
|
||||
(* This file is part of Ocamlmsg. *)
|
||||
|
||||
(* Ocamlmsg 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. *)
|
||||
|
||||
(* Ocamlmsg 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 Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
|
||||
|
||||
type t = Stream of (unit -> (string * t) option)
|
||||
|
||||
let make f = Stream f
|
||||
|
||||
let run (Stream f) = f ()
|
||||
|
||||
let empty = Stream (fun () -> None)
|
||||
let const v = Stream (fun () -> Some (v, empty))
|
||||
|
||||
let rec seq s1 s2 =
|
||||
Stream (fun () ->
|
||||
match run s1 with
|
||||
| None -> run s2
|
||||
| Some (v, k) -> Some (v, seq k s2))
|
||||
|
||||
let rec from_list vs =
|
||||
Stream (fun () ->
|
||||
match vs with
|
||||
| [] -> None
|
||||
| v :: vs -> Some (v, (from_list vs)))
|
||||
|
||||
let rec map f vs =
|
||||
Stream (fun () ->
|
||||
match vs with
|
||||
| [] -> None
|
||||
| v :: vs -> run (seq (f v) (map f vs)))
|
||||
|
||||
let rec from_iter f =
|
||||
let cache = ref None in
|
||||
Stream (fun () ->
|
||||
match !cache with
|
||||
| Some v -> v
|
||||
| None ->
|
||||
let result =
|
||||
(match f () with
|
||||
| Some str -> Some (str, from_iter f)
|
||||
| None -> None)
|
||||
in
|
||||
cache := Some result;
|
||||
result)
|
||||
|
||||
let rec iter f (Stream s_f) =
|
||||
match s_f () with
|
||||
| None -> ()
|
||||
| Some (v, k) -> (f v; iter f k)
|
||||
|
||||
let rec to_list (Stream f) =
|
||||
match f () with
|
||||
| None -> []
|
||||
| Some (v, k) -> v :: to_list k
|
||||
|
||||
let rec to_string s =
|
||||
String.concat "" (to_list s)
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
(* Copyright 2012 Tony Garnock-Jones <tonygarnockjones@gmail.com>. *)
|
||||
|
||||
(* This file is part of Ocamlmsg. *)
|
||||
|
||||
(* Ocamlmsg 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. *)
|
||||
|
||||
(* Ocamlmsg 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 Ocamlmsg. If not, see <http://www.gnu.org/licenses/>. *)
|
||||
|
||||
open Html
|
||||
|
||||
let handle_dynamic_req r =
|
||||
Httpd.http_error_html 500 "Not yet implemented" []
|
||||
|
||||
let handle_req r =
|
||||
if Util.starts_with r.Httpd.path "/_"
|
||||
then handle_dynamic_req r
|
||||
else
|
||||
match r.Httpd.verb with
|
||||
| "GET" -> Httpd_file.resp_file (Filename.concat "./web" r.Httpd.path)
|
||||
| _ -> Httpd.http_error_html 400 ("Unsupported HTTP method "^r.Httpd.verb) []
|
||||
|
||||
let start (s, peername) =
|
||||
Util.create_thread (Connections.endpoint_name peername ^ " HTTP service")
|
||||
None
|
||||
(Httpd.main handle_req)
|
||||
(s, peername)
|
||||
|
||||
let init () =
|
||||
ignore (Util.create_thread "HTTP listener" None (Net.start_net "HTTP" 5678) start)
|
||||
6
util.ml
6
util.ml
|
|
@ -44,3 +44,9 @@ let with_mutex m f arg =
|
|||
raise e
|
||||
|
||||
let with_mutex0 m thunk = with_mutex m thunk ()
|
||||
|
||||
let starts_with s1 s2 =
|
||||
try Str.first_chars s1 (String.length s2) = s2 with _ -> false
|
||||
|
||||
let ends_with s1 s2 =
|
||||
try Str.last_chars s1 (String.length s2) = s2 with _ -> false
|
||||
|
|
|
|||
|
|
@ -0,0 +1,9 @@
|
|||
<html>
|
||||
<head>
|
||||
<title>Ocamlmsg</title>
|
||||
</head>
|
||||
<body>
|
||||
<h1>Ocamlmsg</h1>
|
||||
<p>Welcome to Ocamlmsg.</p>
|
||||
</body>
|
||||
</html>
|
||||
Loading…
Reference in New Issue