irc-bot/client.ml

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;
          nick: string ref;
          username: string ref;
          realname: string ref}


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 command =
  ()

let handle_command_login cli cmd =
  (* Handle a command during the login phase *)
  (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 
                      ~sender:(Some !Irc.name)
                      ~text:(Some "Register first.")
                      "451" ["*"]));
  (match (!(cli.username), !(cli.nick)) with
     | ("", _)
     | (_, "") ->
	 ()
     | (_, nick) ->
	 write cli (Command.create
		      ~sender:(Some !Irc.name)
		      ~text:(Some "*** Hi there.")
		      "NOTICE"
		      [nick]))

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 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 = 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