New iobuf, but there's a problem with login

Specifically, rebinding the command handler doesn't take effect until after
all input lines have been handled.  This means handle_command_prereg doesn't
get new values when it ought to.

OMakefile

@@ -9,7 +9,7 @@ OCAMLCFLAGS += -g
 
 .DEFAULT: ircd
 
-OCamlProgram(ircd, ircd irc command client channel)
+OCamlProgram(ircd, ircd irc command iobuf client channel)
 
 section
     OCAMLPACKS[] +=
@@ -21,7 +21,7 @@ section
     tests.cmo:
     tests$(EXT_OBJ):
 
-    OCamlProgram(tests, tests chat irc command client channel)
+    OCamlProgram(tests, tests chat irc command iobuf client channel)
 
 .PHONY: clean
 clean:

client.ml

@@ -1,17 +1,16 @@
 open Irc
 
+
+
 (* ==========================================
  * Client stuff
  *)
-type t = {outq: Command.t Queue.t;
+type t = {iobuf: Iobuf.t;
-          unsent: string ref;
-          ibuf: string;
-          ibuf_len: int ref;
-          output_ready: unit -> unit;
-          handle_command: (t -> Command.t -> unit) ref;
           nick: string ref;
-          username: string ref;
+          username: string;
-          realname: string ref}
+          realname: string}
+
+exception Error of Command.t
 
 let modes = "l"
 
@@ -20,15 +19,8 @@ let dbg msg a = prerr_endline msg; a
 let by_file_descr = Hashtbl.create 25
 let by_nick = Hashtbl.create 25
 
-let ibuf_max = 4096
+let error num args text =
-let max_outq = 50
+  Error (Command.create (Some !(Irc.name)) num args (Some text))
-let obuf_max = 4096
-
-let lookup nick =
-  Hashtbl.find by_nick nick
-
-let lookup_fd fd =
-  Hashtbl.find by_file_descr fd
 
 let close cli ues g fd =
   Hashtbl.remove by_nick !(cli.nick);
@@ -41,134 +33,71 @@ let close cli ues g fd =
     ()
 
 let write cli cmd =
-  let was_empty = Queue.is_empty cli.outq in
+  Iobuf.write cli.iobuf cmd
-    Queue.add cmd cli.outq;
-    if (was_empty && (!(cli.unsent) = ""))  then
-      cli.output_ready ()
 
-let handle_close cli =
+let reply cli num text =
-  ()
+  write cli (Command.create 
+	       (Some !(Irc.name)) num [!(cli.nick)] (Some text))
 
-let handle_command cli cmd =
+let handle_command cli iobuf cmd =
   write cli cmd
 
-let handle_command_login cli cmd =
-  (* Handle a command during the login phase *)
-  begin
-    match (Command.as_tuple cmd) with
-      | (None, "USER", [username; _; _], Some realname) ->
-          cli.username := username;
-          cli.realname := Irc.truncate realname 40
-      | (None, "NICK", [nick], None) ->
-          cli.nick := nick;
-      | _ ->
-          write cli (Command.create 
-                       (Some !Irc.name) "451" ["*"] (Some "Register first."))
-  end;
-  match (!(cli.username), !(cli.nick)) with
-    | ("", _)
-    | (_, "") ->
-	()
-    | (_, nick) ->
-	cli.handle_command := handle_command;
-	let command name text =
-	  write cli (Command.create 
-		       (Some !(Irc.name))
-		       name
-		       [nick]
-		       (Some text))
-	in
-	  command "001" "Welcome to IRC.";
-	  command "002" ("I am " ^ !(Irc.name) ^ 
-			   " running version " ^ Irc.version);
-	  command "003" "This server was created sometime";
-	  command "004" (!(Irc.name) ^
-			   " " ^ Irc.version ^
-			   " " ^ modes ^
-			   " " ^ Channel.modes)
-
-let crlf = Str.regexp "\r?\n"
-
-let handle_input cli =
-  let buf = Str.string_before cli.ibuf !(cli.ibuf_len) in
-  let lines = Str.split_delim crlf buf in
-  let rec loop l =
-    match l with
-      | [] ->
-	  ()
-      | [leftover] ->
-	  cli.ibuf_len := (String.length leftover);
-	  String.blit leftover 0 cli.ibuf 0 !(cli.ibuf_len)
-      | line :: tl ->
-	  let parsed = Command.from_string line in
-	    !(cli.handle_command) cli parsed;
-	    loop tl
-  in
-    loop lines
-
-let handle_event ues esys e =
-  match e with
-    | Unixqueue.Input_arrived (g, fd) ->
-        let cli = lookup_fd fd in
-        let size = ibuf_max - !(cli.ibuf_len) in
-        let len = Unix.read fd cli.ibuf !(cli.ibuf_len) size in
-          if (len > 0) then
-            begin
-              cli.ibuf_len := !(cli.ibuf_len) + len;
-              try
-                handle_input cli
-              with Not_found ->
-                if (!(cli.ibuf_len) = ibuf_max) then
-                  (* No newline found, and the buffer is full *)
-                  raise (Failure "Buffer overrun");
-            end
-          else
-            close cli ues g fd
-    | Unixqueue.Output_readiness (g, fd) ->
-        (* XXX: Could be optimized to try and fill the output buffer *)
-        let cli = lookup_fd fd in
-        let buf =
-          if (!(cli.unsent) = "") then
-            let cmd = Queue.pop cli.outq in
-              (Command.as_string cmd) ^ "\r\n"
-          else
-            !(cli.unsent)
-        in
-	let buflen = String.length buf in
-        let n = Unix.single_write fd buf 0 buflen in
-	  if n < buflen then
-            cli.unsent := Str.string_after buf n
-	  else if Queue.is_empty cli.outq then
-	    Unixqueue.remove_resource ues g (Unixqueue.Wait_out fd)
-    | Unixqueue.Out_of_band (g, fd) ->
-        print_endline "oob"
-    | Unixqueue.Timeout (g, op) ->
-        print_endline "timeout"
-    | Unixqueue.Signal ->
-        print_endline "signal"
-    | Unixqueue.Extra exn ->
-        print_endline "extra"
-
-
-let create ues g fd =
-  let cli =
-    {outq = Queue.create ();
-     unsent = ref "";
-     ibuf = String.create ibuf_max;
-     ibuf_len = ref 0;
-     output_ready = 
-	begin
-          fun () -> Unixqueue.add_resource ues g (Unixqueue.Wait_out fd, -.1.0)
-	end;
-     handle_command = ref handle_command_login;
-     nick = ref "";
-     username = ref "";
-     realname = ref ""}
-  in
-    Hashtbl.replace by_file_descr fd cli;
-    cli
-
 let set_nick cli nick =
+  if Hashtbl.mem by_nick nick then
+    raise (error "433" [nick] "Nickname in use");
   Hashtbl.remove by_nick !(cli.nick);
   Hashtbl.replace by_nick nick cli;
   cli.nick := nick
+
+let rec handle_command_prereg (nick', username', realname', password') iobuf cmd =
+  (* Handle a command during the login phase *)
+  let acc =
+    match (Command.as_tuple cmd) with
+      | (None, "PASS", [password], None) ->
+	  (nick', username', realname', Some password)
+      | (None, "USER", [username; _; _], Some realname) ->
+	  (nick', Some username, Some (Irc.truncate realname 40), password')
+      | (None, "NICK", [nick], None) ->
+	  (Some nick, username', realname', password')
+      | _ ->
+          Iobuf.write iobuf (Command.create
+			       (Some !(Irc.name)) 
+			       "451" ["*"] 
+			       (Some "Register first."));
+	  (nick', username', realname', password')
+  in
+  let welcome cli =
+    try
+      set_nick cli !(cli.nick);
+      reply cli "001" "Welcome to IRC.";
+      reply cli "002" ("I am " ^ !(Irc.name) ^ 
+			 " Running version " ^ Irc.version);
+      reply cli "003" "This server was created sometime";
+      reply cli "004" (!(Irc.name) ^
+			 " " ^ Irc.version ^
+			 " " ^ modes ^
+			 " " ^ Channel.modes);
+      Iobuf.rebind iobuf (handle_command cli)
+    with Error cmd ->
+      Iobuf.write iobuf cmd
+  in
+  match acc with
+    | (Some nick, Some username, Some realname, None) ->
+	welcome {iobuf = iobuf;
+		 nick = ref nick;
+		 username = username;
+		 realname = realname}
+    | (Some nick, Some username, Some realname, Some password) ->
+	Iobuf.write iobuf (Command.create
+			     (Some !(Irc.name))
+			     "NOTICE" ["AUTH"]
+			     (Some "*** Authentication unimplemented"));
+	welcome {iobuf = iobuf;
+		 nick = ref nick;
+		 username = username;
+		 realname = realname}
+    | _ ->
+	Iobuf.rebind iobuf (handle_command_prereg acc)
+
+let create_command_handler () =
+  handle_command_prereg (None, None, None, None)

client.mli

@@ -1,8 +1,5 @@
 type t
 
-val create : Unixqueue.event_system -> Unixqueue.group -> Unix.file_descr -> t
-val lookup : string -> t
 val write : t -> Command.t -> unit
-
+val create_command_handler : unit -> Iobuf.t -> Command.t -> unit
-val handle_event : Unixqueue.event_system -> Unixqueue.event Equeue.t -> Unixqueue.event -> unit
   

command.ml

@@ -1,33 +1,27 @@
-type t = {sender: string option;
+type t = string option * string * string list * string option
-	  name: string;
-	  args: string list;
-	  text: string option}
 
 let create sender name args text =
-  {sender = sender;
+  (sender, name, args, text)
-   name = name;
-   args = args;
-   text = text}
 
 let anon = create None
 
-let as_string cmd =
+let as_string (sender, name, args, text) =
   let ret = Buffer.create 120 in
-    (match cmd.sender with
+    (match sender with
        | None -> 
 	   ()
        | Some s ->
 	   Buffer.add_char ret ':';
 	   Buffer.add_string ret s;
 	   Buffer.add_char ret ' ');
-    Buffer.add_string ret cmd.name;
+    Buffer.add_string ret name;
-    (match cmd.args with
+    (match args with
        | [] ->
 	   ()
        | l ->
 	   Buffer.add_char ret ' ';
 	   Buffer.add_string ret (String.concat " " l));
-    (match cmd.text with
+    (match text with
        | None ->
 	   ()
        | Some txt ->
@@ -49,12 +43,9 @@ let rec from_string line =
   let rec loop sender acc line =
     let c = (if (line = "") then None else (Some line.[0])) in
       match (c, acc) with
-     	| (None, cmd :: args) ->
+     	| (None, name :: args) ->
      	    (* End of line, no text part *)
-	    {sender = sender;
+	    create sender name args None
-	     name = cmd;
-	     args = args;
-	     text = None}
 	| (None, []) ->
 	    (* End of line, no text part, no args, no command *)
 	    raise (Failure "No command, eh?")
@@ -62,12 +53,9 @@ let rec from_string line =
 	    (* First word, starts with ':' *)
 	    let (word, rest) = extract_word line in
 	      loop (Some (Str.string_after word 1)) acc rest
-	| (Some ':', cmd :: args) ->
+	| (Some ':', name :: args) ->
 	    (* Not first word, starts with ':' *)
-	    {sender = sender;
+	    create sender name args (Some (Str.string_after line 1))
-	     name = cmd;
-	     args = args;
-	     text = Some (Str.string_after line 1)}
 	| (Some _, _) ->
 	    (* Argument *)
 	    let (word, rest) = extract_word line in
@@ -76,10 +64,9 @@ let rec from_string line =
     loop None [] line
 
 
-let as_tuple cmd =
+let as_tuple cmd = cmd
-  (cmd.sender, cmd.name, cmd.args, cmd.text)
 
-let sender cmd = cmd.sender
+let sender (sender, name, args, text) = sender
-let name cmd = cmd.name
+let name (sender, name, args, text) = name
-let args cmd = cmd.args
+let args (sender, name, args, text) = args
-let text cmd = cmd.text
+let text (sender, name, args, text) = text

iobuf.ml

@@ -0,0 +1,121 @@
+(* ==========================================
+ * I/O buf stuff
+ *)
+type t = {ues: Unixqueue.event_system;
+          grp: Unixqueue.group;
+          fd: Unix.file_descr;
+          outq: Command.t Queue.t;
+          unsent: string ref;
+          ibuf: string;
+          ibuf_len: int ref;
+          handle_command: t -> Command.t -> unit}
+
+let ibuf_max = 4096
+let max_outq = 50
+let obuf_max = 4096
+
+let by_file_descr = Hashtbl.create 25
+
+let bind ues grp fd handle_command =
+  let (outq, unsent, ibuf, ibuf_len) =
+    try
+      let old = Hashtbl.find by_file_descr fd in
+        (old.outq, old.unsent, old.ibuf, old.ibuf_len)
+    with Not_found ->
+      (Queue.create (), ref "", String.create ibuf_max, ref 0)
+  in
+  let iobuf = {ues = ues;
+               grp = grp;
+               fd = fd;
+               outq = outq;
+               unsent = unsent;
+               ibuf = ibuf;
+               ibuf_len = ibuf_len;
+               handle_command = handle_command}
+  in
+    Hashtbl.replace by_file_descr fd iobuf;
+    Unixqueue.add_resource ues grp (Unixqueue.Wait_in fd, -.1.0)
+
+let rebind t handle_command =
+  bind t.ues t.grp t.fd handle_command
+
+let write iobuf cmd =
+  let was_empty = Queue.is_empty iobuf.outq in
+    Queue.add cmd iobuf.outq;
+    if (was_empty && (!(iobuf.unsent) = ""))  then
+      Unixqueue.add_resource
+        iobuf.ues iobuf.grp (Unixqueue.Wait_out iobuf.fd, -.1.0)
+
+let close iobuf =
+  Hashtbl.remove by_file_descr iobuf.fd;
+  Unix.close iobuf.fd;
+  Unixqueue.remove_resource iobuf.ues iobuf.grp (Unixqueue.Wait_in iobuf.fd);
+  try
+    Unixqueue.remove_resource iobuf.ues iobuf.grp (Unixqueue.Wait_out iobuf.fd);
+  with Not_found ->
+    ()
+
+let crlf = Str.regexp "\r?\n"
+
+let handle_input iobuf =
+  let buf = Str.string_before iobuf.ibuf !(iobuf.ibuf_len) in
+  let lines = Str.split_delim crlf buf in
+  let rec loop l =
+    match l with
+      | [] ->
+	  ()
+      | [leftover] ->
+	  iobuf.ibuf_len := (String.length leftover);
+	  String.blit leftover 0 iobuf.ibuf 0 !(iobuf.ibuf_len)
+      | line :: tl ->
+	  let parsed = Command.from_string line in
+	    iobuf.handle_command iobuf parsed;
+	    loop tl
+  in
+    loop lines
+
+let handle_event ues esys e =
+  match e with
+    | Unixqueue.Input_arrived (g, fd) ->
+        let iobuf = Hashtbl.find by_file_descr fd in
+        let size = ibuf_max - !(iobuf.ibuf_len) in
+        let len = Unix.read fd iobuf.ibuf !(iobuf.ibuf_len) size in
+          if (len > 0) then
+            begin
+              iobuf.ibuf_len := !(iobuf.ibuf_len) + len;
+              try
+                handle_input iobuf
+              with Not_found ->
+                if (!(iobuf.ibuf_len) = ibuf_max) then
+                  (* No newline found, and the buffer is full *)
+                  raise (Failure "Buffer overrun");
+            end
+          else
+            close iobuf
+    | Unixqueue.Output_readiness (g, fd) ->
+        (* XXX: Could be optimized to try and fill the output buffer *)
+        let iobuf = Hashtbl.find by_file_descr fd in
+        let buf =
+          if (!(iobuf.unsent) = "") then
+            let cmd = Queue.pop iobuf.outq in
+              (Command.as_string cmd) ^ "\r\n"
+          else
+            !(iobuf.unsent)
+        in
+	let buflen = String.length buf in
+        let n = Unix.single_write fd buf 0 buflen in
+	  if n < buflen then
+            iobuf.unsent := Str.string_after buf n
+	  else if Queue.is_empty iobuf.outq then
+	    Unixqueue.remove_resource ues g (Unixqueue.Wait_out fd)
+    | Unixqueue.Out_of_band (g, fd) ->
+        print_endline "oob"
+    | Unixqueue.Timeout (g, op) ->
+        print_endline "timeout"
+    | Unixqueue.Signal ->
+        print_endline "signal"
+    | Unixqueue.Extra exn ->
+        print_endline "extra"
+
+let add_event_handler ues g =
+  Unixqueue.add_handler ues g handle_event

iobuf.mli

@@ -0,0 +1,8 @@
+type t
+
+val write : t -> Command.t -> unit
+val bind : Unixqueue.event_system -> Unixqueue.group -> Unix.file_descr -> (t -> Command.t -> unit) -> unit
+val rebind: t -> (t -> Command.t -> unit) -> unit
+val close: t -> unit
+val add_event_handler : Unixqueue.event_system -> Unixqueue.group -> unit
+

ircd.ml

@@ -28,10 +28,9 @@ let main () =
   let ues = Unixqueue.create_unix_event_system () in
   let g = Unixqueue.new_group ues in
   let handle_connection fd =
-    ignore (Client.create ues g fd);
+    Iobuf.bind ues g fd (Client.create_command_handler ())
-    Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
   in
-    Unixqueue.add_handler ues g Client.handle_event;
+    Iobuf.add_event_handler ues g;
     establish_server
       ues
       handle_connection

tests.ml

@@ -6,9 +6,8 @@ open Irc
 let do_chat script () =
   let ircd_instance ues fd =
     let g = Unixqueue.new_group ues in
-      ignore (Client.create ues g fd);
+      Iobuf.add_event_handler ues g;
-      Unixqueue.add_handler ues g Client.handle_event;
+      Iobuf.bind ues g fd (Client.create_command_handler ())
-      Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
   in
     chat script ircd_instance