mirror of https://github.com/nealey/irc-bot
Merge branch 'master' of git+ssh://neale@fozzie.woozle.org/~neale/src/pgircd
This commit is contained in:
commit
e417d92995
|
|
@ -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:
|
||||
|
|
|
|||
209
client.ml
209
client.ml
|
|
@ -1,17 +1,16 @@
|
|||
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;
|
||||
type t = {iobuf: Iobuf.t;
|
||||
nick: string ref;
|
||||
username: string ref;
|
||||
realname: string ref}
|
||||
username: string;
|
||||
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 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 error num args text =
|
||||
Error (Command.create (Some !(Irc.name)) num args (Some text))
|
||||
|
||||
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
|
||||
Queue.add cmd cli.outq;
|
||||
if (was_empty && (!(cli.unsent) = "")) then
|
||||
cli.output_ready ()
|
||||
Iobuf.write cli.iobuf cmd
|
||||
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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 handle_event : Unixqueue.event_system -> Unixqueue.event Equeue.t -> Unixqueue.event -> unit
|
||||
val create_command_handler : unit -> Iobuf.t -> Command.t -> unit
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,117 @@
|
|||
(* ==========================================
|
||||
* 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) ref}
|
||||
|
||||
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) =
|
||||
(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 = ref 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 =
|
||||
t.handle_command := 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
|
||||
|
|
@ -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
|
||||
|
||||
5
ircd.ml
5
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);
|
||||
Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
|
||||
Iobuf.bind ues g fd (Client.create_command_handler ())
|
||||
in
|
||||
Unixqueue.add_handler ues g Client.handle_event;
|
||||
Iobuf.add_event_handler ues g;
|
||||
establish_server
|
||||
ues
|
||||
handle_connection
|
||||
|
|
|
|||
7
tests.ml
7
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);
|
||||
Unixqueue.add_handler ues g Client.handle_event;
|
||||
Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
|
||||
Iobuf.add_event_handler ues g;
|
||||
Iobuf.bind ues g fd (Client.create_command_handler ())
|
||||
in
|
||||
chat script ircd_instance
|
||||
|
||||
|
|
@ -39,7 +38,7 @@ let do_login nick =
|
|||
Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n");
|
||||
Send ("NICK " ^ nick ^ "\r\n");
|
||||
Recv (":testserver.test 001 " ^ nick ^ " :Welcome to IRC.\r\n");
|
||||
Recv (":testserver.test 002 " ^ nick ^ " :I am testserver.test running version " ^ Irc.version ^ "\r\n");
|
||||
Recv (":testserver.test 002 " ^ nick ^ " :I am testserver.test Running version " ^ Irc.version ^ "\r\n");
|
||||
Recv (":testserver.test 003 " ^ nick ^ " :This server was created sometime\r\n");
|
||||
Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l t\r\n");
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in New Issue