mirror of https://github.com/nealey/irc-bot
160 lines
4.2 KiB
OCaml
160 lines
4.2 KiB
OCaml
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
|