open Irc (* ========================================== * Client stuff *) type t = {outq: Command.t Queue.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; realname: string ref} let modes = "l" 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 max_outq = 50 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); Hashtbl.remove by_file_descr fd; Unix.close fd; Unixqueue.remove_resource ues g (Unixqueue.Wait_in fd); try Unixqueue.remove_resource ues g (Unixqueue.Wait_out fd); with Not_found -> () let write cli cmd = let was_empty = Queue.is_empty cli.outq in Queue.add cmd cli.outq; if (was_empty && (!(cli.unsent) = "")) then cli.output_ready () let handle_close cli = () let handle_command cli 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] -> String.blit leftover 0 cli.ibuf 0 (String.length leftover) | 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 = Hashtbl.remove by_nick !(cli.nick); Hashtbl.replace by_nick nick cli; cli.nick := nick