simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-06 03:05:29 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

remove eio stuff.

Browse source 
it doesn't really bring anything to the table for now. Let's wait until
it becomes actually useful.
This commit is contained in:
Simon Cruanes 2023-08-08 12:39:07 -04:00
parent 51b5b140a9
commit 3802aad11f
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
7 changed files with 0 additions and 493 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
echo_eio.sh
View file

@ -1,2 +0,0 @@
#!/bin/sh
exec dune exec --display=quiet --profile=release "examples/echo_eio.exe" -- $@

7
examples/dune
View file

@ -14,13 +14,6 @@
(modules echo vfs)
(libraries tiny_httpd tiny_httpd_camlzip))
(executable
(name echo_eio)
(flags :standard -warn-error -a+8)
(modules echo_eio)
(libraries tiny_httpd tiny_httpd_camlzip
tiny_httpd_eio eio eio_posix))
(executable
(name writer)
(flags :standard -warn-error -a+8)

246
examples/echo_eio.ml
View file

@ -1,246 +0,0 @@
module S = Tiny_httpd
module S_eio = Tiny_httpd_eio
let now_ = Unix.gettimeofday
let ( let@ ) = ( @@ )
(* util: a little middleware collecting statistics *)
let middleware_stat () : S.Middleware.t * (unit -> string) =
let n_req = ref 0 in
let total_time_ = ref 0. in
let parse_time_ = ref 0. in
let build_time_ = ref 0. in
let write_time_ = ref 0. in
let m h req ~resp =
incr n_req;
let t1 = S.Request.start_time req in
let t2 = now_ () in
h req ~resp:(fun response ->
let t3 = now_ () in
resp response;
let t4 = now_ () in
total_time_ := !total_time_ +. (t4 -. t1);
parse_time_ := !parse_time_ +. (t2 -. t1);
build_time_ := !build_time_ +. (t3 -. t2);
write_time_ := !write_time_ +. (t4 -. t3))
and get_stat () =
Printf.sprintf
"%d requests (average response time: %.3fms = %.3fms + %.3fms + %.3fms)"
!n_req
(!total_time_ /. float !n_req *. 1e3)
(!parse_time_ /. float !n_req *. 1e3)
(!build_time_ /. float !n_req *. 1e3)
(!write_time_ /. float !n_req *. 1e3)
in
m, get_stat
let alice_text =
"CHAPTER I. Down the Rabbit-Hole Alice was beginning to get very tired of \
sitting by her sister on the bank, and of having nothing to do: once or \
twice she had peeped into the book her sister was reading, but it had no \
pictures or conversations in it, <and what is the use of a book,> thought \
Alice <without pictures or conversations?> So she was considering in her \
own mind (as well as she could, for the hot day made her feel very sleepy \
and stupid), whether the pleasure of making a daisy-chain would be worth \
the trouble of getting up and picking the daisies, when suddenly a White \
Rabbit with pink eyes ran close by her. There was nothing so very \
remarkable in that; nor did Alice think it so very much out of the way to \
hear the Rabbit say to itself, <Oh dear! Oh dear! I shall be late!> (when \
she thought it over afterwards, it occurred to her that she ought to have \
wondered at this, but at the time it all seemed quite natural); but when \
the Rabbit actually took a watch out of its waistcoat-pocket, and looked at \
it, and then hurried on, Alice started to her feet, for it flashed across \
her mind that she had never before seen a rabbit with either a \
waistcoat-pocket, or a watch to take out of it, and burning with curiosity, \
she ran across the field after it, and fortunately was just in time to see \
it pop down a large rabbit-hole under the hedge. In another moment down \
went Alice after it, never once considering how in the world she was to get \
out again. The rabbit-hole went straight on like a tunnel for some way, and \
then dipped suddenly down, so suddenly that Alice had not a moment to think \
about stopping herself before she found herself falling down a very deep \
well. Either the well was very deep, or she fell very slowly, for she had \
plenty of time as she went down to look about her and to wonder what was \
going to happen next. First, she tried to look down and make out what she \
was coming to, but it was too dark to see anything; then she looked at the \
sides of the well, and noticed that they were filled with cupboards......"
let () =
let port_ = ref 8080 in
let j = ref 32 in
Arg.parse
(Arg.align
[
"--port", Arg.Set_int port_, " set port";
"-p", Arg.Set_int port_, " set port";
"--debug", Arg.Unit (fun () -> S._enable_debug true), " enable debug";
"-j", Arg.Set_int j, " maximum number of connections";
])
(fun _ -> raise (Arg.Bad ""))
"echo [option]*";
(* use eio *)
let@ stdenv = Eio_posix.run in
let@ sw = Eio.Switch.run in
(* create server *)
let server : S.t =
S_eio.create ~port:!port_ ~max_connections:!j
~stdenv:(stdenv :> Eio_unix.Stdenv.base)
~sw ()
in
Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server;
let m_stats, get_stats = middleware_stat () in
S.add_middleware server ~stage:(`Stage 1) m_stats;
(* say hello *)
S.add_route_handler ~meth:`GET server
S.Route.(exact "hello" @/ string @/ return)
(fun name _req -> S.Response.make_string (Ok ("hello " ^ name ^ "!\n")));
(* compressed file access *)
S.add_route_handler ~meth:`GET server
S.Route.(exact "zcat" @/ string_urlencoded @/ return)
(fun path _req ->
let ic = open_in path in
let str = S.Byte_stream.of_chan ic in
let mime_type =
try
let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" path) in
try
let s = [ "Content-Type", String.trim (input_line p) ] in
ignore @@ Unix.close_process_in p;
s
with _ ->
ignore @@ Unix.close_process_in p;
[]
with _ -> []
in
S.Response.make_stream ~headers:mime_type (Ok str));
(* echo request *)
S.add_route_handler server
S.Route.(exact "echo" @/ return)
(fun req ->
let q =
S.Request.query req
|> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v)
|> String.concat ";"
in
S.Response.make_string
(Ok (Format.asprintf "echo:@ %a@ (query: %s)@." S.Request.pp req q)));
(* file upload *)
S.add_route_handler_stream ~meth:`PUT server
S.Route.(exact "upload" @/ string @/ return)
(fun path req ->
S._debug (fun k ->
k "start upload %S, headers:\n%s\n\n%!" path
(Format.asprintf "%a" S.Headers.pp (S.Request.headers req)));
try
let oc = open_out @@ "/tmp/" ^ path in
S.Byte_stream.to_chan oc req.S.Request.body;
flush oc;
S.Response.make_string (Ok "uploaded file")
with e ->
S.Response.fail ~code:500 "couldn't upload file: %s"
(Printexc.to_string e));
(* stats *)
S.add_route_handler server
S.Route.(exact "stats" @/ return)
(fun _req ->
let stats = get_stats () in
S.Response.make_string @@ Ok stats);
S.add_route_handler server ~meth:`POST
S.Route.(exact "quit" @/ return)
(fun _req ->
S.stop server;
S.Response.make_string (Ok "quitting"));
S.add_route_handler server
S.Route.(exact "alice" @/ return)
(fun _req -> S.Response.make_string (Ok alice_text));
(* main page *)
S.add_route_handler server
S.Route.(return)
(fun _req ->
let open Tiny_httpd_html in
let h =
html []
[
head [] [ title [] [ txt "index of echo" ] ];
body []
[
h3 [] [ txt "welcome!" ];
p [] [ b [] [ txt "endpoints are:" ] ];
ul []
[
li [] [ pre [] [ txt "/hello/:name (GET)" ] ];
li []
[
pre []
[
a [ A.href "/echo/" ] [ txt "echo" ];
txt " echo back query";
];
];
li []
[ pre [] [ txt "/upload/:path (PUT) to upload a file" ] ];
li []
[
pre []
[
txt
"/zcat/:path (GET) to download a file (deflate \
transfer-encoding)";
];
];
li []
[
pre []
[
a [ A.href "/stats/" ] [ txt "/stats/" ];
txt " (GET) to access statistics";
];
];
li []
[
pre []
[
a [ A.href "/vfs/" ] [ txt "/vfs" ];
txt " (GET) to access a VFS embedded in the binary";
];
];
li []
[
pre
[ A.style "display: inline" ]
[
a [ A.href "/quit" ] [ txt "/quit" ];
txt " (POST) to stop server";
];
form
[
A.style "display: inline";
A.action "/quit";
A.method_ "POST";
]
[ button [ A.type_ "submit" ] [ txt "quit" ] ];
];
];
];
]
in
let s = to_string_top h in
S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s);
Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
let res = S.run server in
Gc.print_stat stdout;
match res with
| Ok () -> ()
| Error e -> raise e

8
src/eio/dune
View file

@ -1,8 +0,0 @@
(library
(name tiny_httpd_eio)
(public_name tiny_httpd_eio)
(synopsis "An EIO-based backend for Tiny_httpd")
(flags :standard -safe-string -warn-error -a+8)
(libraries tiny_httpd eio eio.unix))

178
src/eio/tiny_httpd_eio.ml
View file

@ -1,178 +0,0 @@
module IO = Tiny_httpd_io
module H = Tiny_httpd_server
module Pool = Tiny_httpd_pool
let ( let@ ) = ( @@ )
type 'a with_args =
?addr:string ->
?port:int ->
?max_connections:int ->
stdenv:Eio_unix.Stdenv.base ->
sw:Eio.Switch.t ->
'a
let get_max_connection_ ?(max_connections = 64) () : int =
let max_connections = max 4 max_connections in
max_connections
let buf_size = 16 * 1024
let ic_of_flow ~buf_pool:ic_pool (flow : Eio.Net.stream_socket) :
IO.In_channel.t =
Pool.with_resource ic_pool @@ fun cstruct ->
let len_slice = ref 0 in
let offset = ref 0 in
let input buf i len =
if len = 0 then
0
else (
let available = ref (!len_slice - !offset) in
if !available = 0 then (
let n = flow#read_into cstruct in
offset := 0;
len_slice := n;
available := n
);
let n = min !available len in
if n > 0 then (
Cstruct.blit_to_bytes cstruct !offset buf i n;
offset := !offset + n;
n
) else
0
)
in
let close () = flow#shutdown `Receive in
{ IO.In_channel.input; close }
let oc_of_flow ~buf_pool:oc_pool (flow : Eio.Net.stream_socket) :
IO.Out_channel.t =
(* write buffer *)
Pool.with_resource oc_pool @@ fun wbuf ->
let offset = ref 0 in
let flush () =
if !offset > 0 then (
let i = ref 0 in
let len = ref !offset in
let src =
object
inherit Eio.Flow.source
method read_into (cstruct : Cstruct.t) : int =
if !len = 0 then raise End_of_file;
let n = min !len (Cstruct.length cstruct) in
Cstruct.blit_from_bytes wbuf !i cstruct 0 n;
i := !i + n;
len := !len - n;
n
end
in
flow#copy src;
offset := 0
)
in
let output buf i len =
let i = ref i in
let len = ref len in
while !len > 0 do
let available = Bytes.length wbuf - !offset in
let n = min !len available in
Bytes.blit buf !i wbuf !offset n;
offset := !offset + n;
i := !i + n;
len := !len - n;
if !offset = Bytes.length wbuf then flush ()
done
in
let output_char c =
if !offset = Bytes.length wbuf then flush ();
Bytes.set wbuf !offset c;
incr offset;
if !offset = Bytes.length wbuf then flush ()
in
let close () = flow#shutdown `Send in
{ IO.Out_channel.close; flush; output; output_char }
let io_backend ?(addr = "127.0.0.1") ?(port = 8080) ?max_connections
~(stdenv : Eio_unix.Stdenv.base) ~(sw : Eio.Switch.t) () :
(module H.IO_BACKEND) =
let module M = struct
let init_addr () = addr
let init_port () = port
let get_time_s () = Unix.gettimeofday ()
let ic_pool = Pool.create ~mk_item:(fun () -> Cstruct.create buf_size) ()
let oc_pool = Pool.create ~mk_item:(fun () -> Bytes.create buf_size) ()
let tcp_server () : IO.TCP_server.builder =
{
IO.TCP_server.serve =
(fun ~after_init ~handle () : unit ->
(* FIXME: parse *)
let ip_addr = Eio.Net.Ipaddr.V4.any in
let running = Atomic.make true in
let active_conns = Atomic.make 0 in
Eio.Switch.on_release sw (fun () -> Atomic.set running false);
let net = Eio.Stdenv.net stdenv in
(* main server socket *)
let sock =
let backlog = get_max_connection_ ?max_connections () in
Eio.Net.listen ~reuse_addr:true ~reuse_port:true ~backlog ~sw net
(`Tcp (ip_addr, port))
in
let tcp_server : IO.TCP_server.t =
{
running = (fun () -> Atomic.get running);
stop =
(fun () ->
Atomic.set running false;
Eio.Switch.fail sw Exit);
endpoint =
(fun () ->
(* TODO: find the real port *)
addr, port);
active_connections = (fun () -> Atomic.get active_conns);
}
in
after_init tcp_server;
while Atomic.get running do
Eio.Net.accept_fork ~sw
~on_error:(fun exn ->
H._debug (fun k ->
k "error in client handler: %s" (Printexc.to_string exn)))
sock
(fun flow _client_addr ->
Atomic.incr active_conns;
let@ () =
Fun.protect ~finally:(fun () ->
H._debug (fun k ->
k "Tiny_httpd_eio: client handler returned");
Atomic.decr active_conns)
in
let ic = ic_of_flow ~buf_pool:ic_pool flow in
let oc = oc_of_flow ~buf_pool:oc_pool flow in
handle.handle ic oc)
done);
}
end in
(module M)
let create ?addr ?port ?max_connections ~stdenv ~sw ?buf_size ?middlewares () :
H.t =
let backend = io_backend ?addr ?port ?max_connections ~stdenv ~sw () in
H.create_from ?buf_size ?middlewares ~backend ()

30
src/eio/tiny_httpd_eio.mli
View file

@ -1,30 +0,0 @@
(** Tiny httpd EIO backend.
This replaces the threads + Unix blocking syscalls of {!Tiny_httpd_server}
with an Eio-based cooperative system.
{b NOTE}: this is very experimental and will absolutely change over time,
especially since Eio itself is also subject to change.
@since NEXT_RELEASE *)
(* TODO: pass in a switch *)
type 'a with_args =
?addr:string ->
?port:int ->
?max_connections:int ->
stdenv:Eio_unix.Stdenv.base ->
sw:Eio.Switch.t ->
'a
val io_backend : (unit -> (module Tiny_httpd_server.IO_BACKEND)) with_args
(** Create a server *)
val create :
(?buf_size:int ->
?middlewares:
([ `Encoding | `Stage of int ] * Tiny_httpd_server.Middleware.t) list ->
unit ->
Tiny_httpd_server.t)
with_args
(** Create a server *)

22
tiny_httpd_eio.opam
View file

@ -1,22 +0,0 @@
opam-version: "2.0"
version: "0.13"
authors: ["Simon Cruanes"]
maintainer: "simon.cruanes.2007@m4x.org"
license: "MIT"
synopsis: "Run tiny_httpd on Eio"
build: [
["dune" "build" "@install" "-p" name "-j" jobs]
["dune" "build" "@doc" "-p" name] {with-doc}
["dune" "runtest" "-p" name] {with-test}
]
depends: [
"dune" { >= "2.0" }
"eio" {>= "0.9"}
"tiny_httpd" { = version }
"odoc" {with-doc}
]
tags: [ "http" "server" "eio" ]
homepage: "https://github.com/c-cube/tiny_httpd/"
doc: "https://c-cube.github.io/tiny_httpd/"
bug-reports: "https://github.com/c-cube/tiny_httpd/issues"
dev-repo: "git+https://github.com/c-cube/tiny_httpd.git"