irc-bot/client.ml

174 lines
4.6 KiB
OCaml
Raw Normal View History

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