From da5e37dbc2410680961e5606bbe8f5d8b8ae549f Mon Sep 17 00:00:00 2001 From: Christopher League Date: Mon, 16 Apr 2007 18:09:46 -0400 Subject: [PATCH] svn-r7: satisfied with static performance, for now darcs-hash:20070416220946-e5a07-58527017f4c0949edbe386974811c9288b59be2b.gz --- Makefile | 6 +-- Makefile.rules | 1 + bench/static-overhead | 19 ++++++++-- scripts/Makefile | 14 ++++--- scripts/run_ | 5 ++- server/Makefile | 3 +- server/Makefile.depend | 5 +++ server/chunked.ml | 86 +++++++++++++++++++++++++++--------------- server/chunked.mli | 6 +-- server/codeHandler.ml | 22 ++++------- server/codeHandler.mli | 3 ++ server/fileHandler.ml | 2 +- server/server.ml | 2 + server/server.mli | 1 + 14 files changed, 110 insertions(+), 65 deletions(-) create mode 100644 server/codeHandler.mli diff --git a/Makefile b/Makefile index 59dfa02..061a6b9 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,6 @@ +include Makefile.rules subdirs=server metac scripts paper -mlflags=-I server +mlflags+=-I server default: for d in $(subdirs); do $(MAKE) -C $$d default; done @@ -22,9 +23,8 @@ reallyclean: clean method=camlcode static-bench: - for n in 01 02 04; do \ + for n in $(sizes); do \ bench/static-overhead $(method) $$n 2>&1 \ | tee bench/static.$(method).$$n; \ done -include Makefile.rules diff --git a/Makefile.rules b/Makefile.rules index 6c7cf6e..5b35d7f 100644 --- a/Makefile.rules +++ b/Makefile.rules @@ -23,3 +23,4 @@ mlflags+=-I +threads $(ocamlc) -c $< junk=*.cm? *~ +sizes=01 02 04 08 16 32 64 diff --git a/bench/static-overhead b/bench/static-overhead index f0cd292..39049d3 100755 --- a/bench/static-overhead +++ b/bench/static-overhead @@ -5,8 +5,13 @@ # camlfile # camlcode -set -m -make run & +case $1 in + caml*) + set -m + make -C.. run & + sleep 4 + ;; +esac echo '========================================' $1-$2 @@ -14,6 +19,9 @@ case $1 in apache) url=http://localhost/static$2.meta ;; + php) + url=http://localhost/static$2.php + ;; camlfile) url=http://localhost:8000/scripts/static$2.meta ;; @@ -21,8 +29,11 @@ case $1 in url=http://localhost:8000/static$2 ;; esac -sleep 4 ab -k -t 30 -c 8 $url -kill -INT %% +case $1 in + caml*) + kill -INT %% + ;; +esac diff --git a/scripts/Makefile b/scripts/Makefile index 5c4e24c..c34302d 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,14 +1,17 @@ -sizes=01 02 04 08 16 32 64 -scripts=dir power gc $(addprefix static, $(sizes)) +include ../Makefile.rules + +scripts= power gc $(addprefix static, $(sizes)) +#dir +mlfiles=$(addsuffix .ml, $(scripts)) default: run run: all run_ cat $^ >$@ -all: $(addsuffix .ml, $(scripts)) +all: $(mlfiles) Makefile echo -n >$@ - for x in $^; do \ + for x in $(mlfiles); do \ echo '#use "scripts/'$$x'";;' >>$@; \ done @@ -21,9 +24,8 @@ static%.meta: mimencode $@ clean: - rm -f $(junk) all run $(addsuffix .ml, $(scripts)) + rm -f $(junk) all run $(mlfiles) reallyclean: clean rm -f static*.meta -include ../Makefile.rules diff --git a/scripts/run_ b/scripts/run_ index 6ac365f..f81442d 100644 --- a/scripts/run_ +++ b/scripts/run_ @@ -2,12 +2,14 @@ let code_map = List.fold_right (fun(uri,scr) map->StringMap.add uri scr map) [ +(* "/browse", .! Dir.page "."; "/server/", .! Dir.page "server"; "/scripts/", .! Dir.page "scripts"; "/paper/", .! Dir.page "paper"; "/metac/", .! Dir.page "metac"; "/images/", .! Dir.page "images"; + *) "/power7", .! Power.page (Num.Int 7); "/power17", .! Power.page (Num.Int 17); @@ -28,5 +30,6 @@ let code_map = #use "server/codeHandler.ml";; Sys.set_signal Sys.sigpipe Sys.Signal_ignore;; Sys.catch_break true;; -Server.start [CodeHandler.run; CodeHandler.redirect; +Server.start [CodeHandler.run code_map; + CodeHandler.redirect code_map; FileHandler.root "."];; diff --git a/server/Makefile b/server/Makefile index 271a926..a76913b 100644 --- a/server/Makefile +++ b/server/Makefile @@ -1,5 +1,6 @@ include ../Makefile.rules -objects=chunked timeStamp stringMap status request logFile server fileHandler +objects=chunked timeStamp stringMap status request \ + logFile server fileHandler codeHandler default: server.cma diff --git a/server/Makefile.depend b/server/Makefile.depend index 655145d..f8b8436 100644 --- a/server/Makefile.depend +++ b/server/Makefile.depend @@ -19,3 +19,8 @@ fileHandler.cmo: logFile.cmi request.cmi server.cmi status.cmi timeStamp.cmi \ fileHandler.cmx: logFile.cmx request.cmx server.cmx status.cmx timeStamp.cmx \ fileHandler.cmi fileHandler.cmi: server.cmi +codeHandler.cmo: chunked.cmi request.cmi server.cmi status.cmi stringMap.cmi \ + timeStamp.cmi codeHandler.cmi +codeHandler.cmx: chunked.cmx request.cmx server.cmx status.cmx stringMap.cmx \ + timeStamp.cmx codeHandler.cmi +codeHandler.cmi: request.cmi server.cmi stringMap.cmi diff --git a/server/chunked.ml b/server/chunked.ml index 25c80f7..7eb66de 100644 --- a/server/chunked.ml +++ b/server/chunked.ml @@ -1,32 +1,56 @@ -type t = { chan: out_channel; - buf: Buffer.t; - size: int } - -let create chan size = - { chan = chan; - buf = Buffer.create size; - size = size } - -let flush out = - match Buffer.length out.buf with - 0 -> () - | k -> - Printf.fprintf out.chan "%x\r\n" k; - Buffer.output_buffer out.chan out.buf; - output_string out.chan "\r\n"; - Buffer.clear out.buf - -let puts out str = - Buffer.add_string out.buf str; - if Buffer.length out.buf >= out.size - then flush out - -let putc out char = - Buffer.add_char out.buf char; - if Buffer.length out.buf >= out.size - then flush out - -let finish out = - flush out; - output_string out.chan "0\r\n" +type t = + { fd: Unix.file_descr; + buf: string; + size: int; + mutable pos: int + } + +let descr fd size = + { fd = fd; + buf = String.create size; + size = size - 2; (* so there is always room for CR/LF *) + pos = 0 } + +let channel ch size = + flush ch; + descr (Unix.descr_of_out_channel ch) size + +let write fd s n = + let k = Unix.write fd s 0 n in + if n <> k then failwith "Chunked.write: incomplete" + +let write_string fd s = + write fd s (String.length s) + +let write_chunk_header fd n = + write_string fd (Printf.sprintf "%x\r\n" n) + +let add_crlf s k = + String.set s k '\r'; + String.set s (k+1) '\n' + +let flush stream = + let n = stream.pos in + if n > 0 then + (write_chunk_header stream.fd n; + add_crlf stream.buf n; + write stream.fd stream.buf (n+2); + stream.pos <- 0) + +let puts stream text = + let n = String.length text in + if stream.pos + n > stream.size then + flush stream; + if n > stream.size then + (write_chunk_header stream.fd n; + write_string stream.fd text; + write_string stream.fd "\r\n") + else + (String.blit text 0 stream.buf stream.pos n; + stream.pos <- stream.pos + n) + +let finish stream = + flush stream; + write_string stream.fd "0\r\n" + diff --git a/server/chunked.mli b/server/chunked.mli index 74219e6..8d2877d 100644 --- a/server/chunked.mli +++ b/server/chunked.mli @@ -1,6 +1,6 @@ type t -val create : out_channel -> int -> t +val channel : out_channel -> int -> t +val descr : Unix.file_descr -> int -> t +val puts : t -> string -> unit val flush : t -> unit val finish : t -> unit -val puts : t -> string -> unit -val putc : t -> char -> unit diff --git a/server/codeHandler.ml b/server/codeHandler.ml index ad88d17..82f687a 100644 --- a/server/codeHandler.ml +++ b/server/codeHandler.ml @@ -1,23 +1,16 @@ - -module type CodeHandler = - sig - val run : Server.handler - val redirect : Server.handler - end - -module CodeHandler : CodeHandler = struct + type code = Request.req -> (string -> unit) -> unit let chunked_response f o = output_string o "Transfer-encoding: chunked\r\n\r\n"; flush o; - let ch = Chunked.create o 512 in + let ch = Chunked.channel o Server.bufsize in f (Chunked.puts ch); Chunked.finish ch; (* footers go here *) output_string o "\r\n" let buffered_response f o = - let buf = Buffer.create 512 in + let buf = Buffer.create Server.bufsize in f (Buffer.add_string buf); Printf.fprintf o "Content-length: %d\r\n" (Buffer.length buf); (* headers go here *) @@ -32,10 +25,10 @@ module CodeHandler : CodeHandler = struct (* NEED A WAY FOR script function to send additional headers *) (* would be nice to support HEAD *) - let run req o = + let run map req o = (match Request.meth req with Request.GET -> - let code = StringMap.find (Request.uri req) code_map in + let code = StringMap.find (Request.uri req) map in let fn puts = try (*Mutex.lock mutex; @@ -63,11 +56,11 @@ module CodeHandler : CodeHandler = struct "/dir" --> "/dir/" *) - let redirect req o = + let redirect map req o = (match Request.meth req with Request.GET -> let uri' = Request.uri req ^ "/" in - let _ = StringMap.find uri' code_map in + let _ = StringMap.find uri' map in let url = "http://" in let url = url^Unix.gethostname() in let url = @@ -92,4 +85,3 @@ module CodeHandler : CodeHandler = struct Status.Moved_permanently | _ -> raise Server.Not_implemented) -end diff --git a/server/codeHandler.mli b/server/codeHandler.mli new file mode 100644 index 0000000..d03715f --- /dev/null +++ b/server/codeHandler.mli @@ -0,0 +1,3 @@ +type code = Request.req -> (string -> unit) -> unit +val run : code StringMap.t -> Server.handler +val redirect : code StringMap.t -> Server.handler diff --git a/server/fileHandler.ml b/server/fileHandler.ml index 2150459..e88f374 100644 --- a/server/fileHandler.ml +++ b/server/fileHandler.ml @@ -54,7 +54,7 @@ let copy o' (path, st) = flush o'; let o = descr_of_out_channel o' in let i = openfile path [O_RDONLY] 0 in - let size = min st.st_size 8192 in + let size = min st.st_size Server.bufsize in let buf = String.create size in while match read i buf 0 size with diff --git a/server/server.ml b/server/server.ml index 40e7d87..eac0b49 100644 --- a/server/server.ml +++ b/server/server.ml @@ -1,5 +1,7 @@ open Unix +let bufsize = 4096 + module TMap = Map.Make (struct type t = Thread.t diff --git a/server/server.mli b/server/server.mli index 0b62a75..d014468 100644 --- a/server/server.mli +++ b/server/server.mli @@ -6,3 +6,4 @@ exception Forbidden val start: ?port:int -> ?logfile:string -> handler list -> server val stop: server -> unit +val bufsize: int (* recommended size for buffering *)