Passing all unit tests again

This commit is contained in:
Neale Pickett 2008-03-18 21:04:22 -06:00
parent 8616bb1f80
commit 7b80acfbbe
1 changed files with 34 additions and 29 deletions

View File

@ -10,7 +10,7 @@ type t = {d: Dispatch.t;
addr: Unix.sockaddr; addr: Unix.sockaddr;
handle_command: command_handler ref; handle_command: command_handler ref;
handle_error: error_handler ref; handle_error: error_handler ref;
valid: bool ref} alive: bool ref}
and command_handler = t -> Command.t -> unit and command_handler = t -> Command.t -> unit
and error_handler = t -> string -> unit and error_handler = t -> string -> unit
@ -26,12 +26,6 @@ let addr iobuf =
| Unix.ADDR_INET (addr, port) -> | Unix.ADDR_INET (addr, port) ->
Unix.string_of_inet_addr addr Unix.string_of_inet_addr addr
let write iobuf cmd =
let was_empty = Queue.is_empty iobuf.outq in
Queue.add cmd iobuf.outq;
if (was_empty && (!(iobuf.unsent) = "")) then
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let crlf = Str.regexp "\r?\n" let crlf = Str.regexp "\r?\n"
let handle_input iobuf = let handle_input iobuf =
@ -53,9 +47,18 @@ let handle_input iobuf =
let close iobuf message = let close iobuf message =
!(iobuf.handle_error) iobuf message; !(iobuf.handle_error) iobuf message;
iobuf.valid := false; iobuf.alive := false;
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output] Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let write iobuf cmd =
match Queue.length iobuf.outq with
| a when a = max_outq ->
close iobuf "Max outq exceeded"
| len ->
Queue.add cmd iobuf.outq;
if ((len = 0) && (!(iobuf.unsent) = "")) then
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let rec handle_events iobuf fd events = let rec handle_events iobuf fd events =
match events with match events with
| [] -> | [] ->
@ -71,28 +74,30 @@ let rec handle_events iobuf fd events =
else else
handle_events iobuf fd tl handle_events iobuf fd tl
| Dispatch.Output :: tl -> | Dispatch.Output :: tl ->
(* XXX: Could be optimized to try and fill the output buffer *) let buf = Buffer.create obuf_max in
let buf = Buffer.add_string buf !(iobuf.unsent);
if (!(iobuf.unsent) = "") then while (((Buffer.length buf) < obuf_max) &&
(not (Queue.is_empty iobuf.outq))) do
let cmd = Queue.pop iobuf.outq in let cmd = Queue.pop iobuf.outq in
(Command.as_string cmd) ^ "\r\n" Buffer.add_string buf (Command.as_string cmd);
else Buffer.add_string buf "\r\n"
!(iobuf.unsent) done;
in let bufstr = Buffer.contents buf in
let buflen = String.length buf in let buflen = Buffer.length buf in
let n = Unix.single_write fd buf 0 buflen in let n = Unix.single_write fd bufstr 0 buflen in
if n < buflen then begin if n < buflen then begin
iobuf.unsent := Str.string_after buf n; iobuf.unsent := Str.string_after bufstr n;
handle_events iobuf fd tl
end else if Queue.is_empty iobuf.outq then
if !(iobuf.valid) then begin
Dispatch.modify iobuf.d fd [Dispatch.Input];
handle_events iobuf fd tl handle_events iobuf fd tl
end else begin end else if Queue.is_empty iobuf.outq then
(* Close invalid connection after all output has despooled *) if !(iobuf.alive) then begin
Dispatch.delete iobuf.d iobuf.fd; (* We're out of data to send *)
Unix.close iobuf.fd Dispatch.modify iobuf.d fd [Dispatch.Input];
end handle_events iobuf fd tl
end else begin
(* Close dead connection after all output has despooled *)
Dispatch.delete iobuf.d iobuf.fd;
Unix.close iobuf.fd
end
| Dispatch.Priority :: tl -> | Dispatch.Priority :: tl ->
let s = String.create 4096 in let s = String.create 4096 in
ignore (Unix.recv fd s 0 4096 [Unix.MSG_OOB]); ignore (Unix.recv fd s 0 4096 [Unix.MSG_OOB]);
@ -116,5 +121,5 @@ let create d fd addr handle_command handle_error =
addr = addr; addr = addr;
handle_command = ref handle_command; handle_command = ref handle_command;
handle_error = ref handle_error; handle_error = ref handle_error;
valid = ref true} in alive = ref true} in
Dispatch.add d fd (handle_events iobuf) [Dispatch.Input] Dispatch.add d fd (handle_events iobuf) [Dispatch.Input]