mirror of https://github.com/nealey/irc-bot
Skeleton for all IRC commands, implemented a few, add (chat.Regex of string)
This commit is contained in:
parent
e417d92995
commit
ac369d30c2
149
chat.ml
149
chat.ml
|
|
@ -5,16 +5,21 @@ exception Buffer_overrun
|
|||
type chat_event =
|
||||
| Send of string
|
||||
| Recv of string
|
||||
| Regex of string
|
||||
|
||||
exception Chat_match of (chat_event * chat_event)
|
||||
exception Chat_match of (string * chat_event)
|
||||
exception Chat_timeout of chat_event
|
||||
|
||||
let dbg msg a = prerr_endline msg; a
|
||||
|
||||
let string_of_chat_event e =
|
||||
match e with
|
||||
| Send str ->
|
||||
("Send(\"" ^ (String.escaped str) ^ "\")")
|
||||
("Send (\"" ^ (String.escaped str) ^ "\")")
|
||||
| Recv str ->
|
||||
("Recv(\"" ^ (String.escaped str) ^ "\")")
|
||||
("Recv (\"" ^ (String.escaped str) ^ "\")")
|
||||
| Regex str ->
|
||||
("Regex (\"" ^ (String.escaped str) ^ "\")")
|
||||
|
||||
(** Return true if str starts with substr *)
|
||||
let startswith str substr =
|
||||
|
|
@ -64,7 +69,7 @@ object (self)
|
|||
method write data =
|
||||
let data_len = String.length data in
|
||||
if (data_len + obuf_len > output_max) then
|
||||
raise Buffer_overrun;
|
||||
raise Buffer_overrun;
|
||||
String.blit data 0 obuf obuf_len data_len;
|
||||
obuf_len <- obuf_len + data_len;
|
||||
ues#add_resource g (Wait_out fd, output_timeout)
|
||||
|
|
@ -72,71 +77,87 @@ object (self)
|
|||
method handle_event ues esys e =
|
||||
match e with
|
||||
| Input_arrived (g, fd) ->
|
||||
let data = String.create input_max in
|
||||
let len = Unix.read fd data 0 input_max in
|
||||
if (len > 0) then
|
||||
begin
|
||||
Buffer.add_string inbuf (String.sub data 0 len);
|
||||
self#run_script ()
|
||||
end
|
||||
else
|
||||
begin
|
||||
Unix.close fd;
|
||||
ues#clear g;
|
||||
end
|
||||
let data = String.create input_max in
|
||||
let len = Unix.read fd data 0 input_max in
|
||||
if (len > 0) then
|
||||
begin
|
||||
Buffer.add_string inbuf (String.sub data 0 len);
|
||||
self#run_script ()
|
||||
end
|
||||
else
|
||||
begin
|
||||
Unix.close fd;
|
||||
ues#clear g;
|
||||
end
|
||||
| Output_readiness (g, fd) ->
|
||||
let size = obuf_len in
|
||||
let n = Unix.single_write fd obuf 0 size in
|
||||
obuf_len <- obuf_len - n;
|
||||
if (obuf_len = 0) then
|
||||
(* Don't check for output readiness anymore *)
|
||||
begin
|
||||
ues#remove_resource g (Wait_out fd)
|
||||
end
|
||||
else
|
||||
(* Put unwritten output back into the output queue *)
|
||||
begin
|
||||
String.blit obuf n obuf 0 (obuf_len)
|
||||
end
|
||||
let size = obuf_len in
|
||||
let n = Unix.single_write fd obuf 0 size in
|
||||
obuf_len <- obuf_len - n;
|
||||
if (obuf_len = 0) then
|
||||
(* Don't check for output readiness anymore *)
|
||||
begin
|
||||
ues#remove_resource g (Wait_out fd)
|
||||
end
|
||||
else
|
||||
(* Put unwritten output back into the output queue *)
|
||||
begin
|
||||
String.blit obuf n obuf 0 (obuf_len)
|
||||
end
|
||||
| Out_of_band (g, fd) ->
|
||||
raise (Failure "Out of band data")
|
||||
raise (Failure "Out of band data")
|
||||
| Timeout (g, op) ->
|
||||
raise (Chat_timeout (List.hd script))
|
||||
raise (Chat_timeout (List.hd script))
|
||||
| Signal ->
|
||||
raise (Failure "Signal")
|
||||
raise (Failure "Signal")
|
||||
| Extra exn ->
|
||||
raise (Failure "Extra")
|
||||
raise (Failure "Extra")
|
||||
|
||||
method run_script () =
|
||||
match script with
|
||||
| [] ->
|
||||
Unix.close fd;
|
||||
ues#clear g
|
||||
Unix.close fd;
|
||||
ues#clear g
|
||||
| Send buf :: tl ->
|
||||
self#write buf;
|
||||
script <- tl;
|
||||
self#run_script ()
|
||||
self#write buf;
|
||||
script <- tl;
|
||||
self#run_script ()
|
||||
| Recv buf :: tl ->
|
||||
let buf_len = String.length buf in
|
||||
let inbuf_str = Buffer.contents inbuf in
|
||||
if (Buffer.length inbuf >= buf_len) then
|
||||
if startswith inbuf_str buf then
|
||||
begin
|
||||
script <- tl;
|
||||
Buffer.clear inbuf;
|
||||
Buffer.add_substring
|
||||
inbuf
|
||||
inbuf_str
|
||||
buf_len
|
||||
((String.length inbuf_str) - buf_len);
|
||||
self#run_script ()
|
||||
end
|
||||
else
|
||||
raise (Chat_match (Recv inbuf_str,
|
||||
Recv buf))
|
||||
else
|
||||
()
|
||||
|
||||
let buf_len = String.length buf in
|
||||
let inbuf_str = Buffer.contents inbuf in
|
||||
if (Buffer.length inbuf >= buf_len) then
|
||||
if startswith inbuf_str buf then
|
||||
begin
|
||||
script <- tl;
|
||||
Buffer.clear inbuf;
|
||||
Buffer.add_substring
|
||||
inbuf
|
||||
inbuf_str
|
||||
buf_len
|
||||
((String.length inbuf_str) - buf_len);
|
||||
self#run_script ()
|
||||
end
|
||||
else
|
||||
raise (Chat_match (inbuf_str, Recv buf))
|
||||
else
|
||||
()
|
||||
| Regex buf :: tl ->
|
||||
let inbuf_str = Buffer.contents inbuf in
|
||||
let matched = Str.string_match (Str.regexp buf) inbuf_str 0 in
|
||||
if (Buffer.length inbuf > 0) then
|
||||
if matched then
|
||||
let match_len = Str.match_end () in
|
||||
script <- tl;
|
||||
Buffer.clear inbuf;
|
||||
Buffer.add_substring
|
||||
inbuf
|
||||
inbuf_str
|
||||
match_len
|
||||
((String.length inbuf_str) - match_len);
|
||||
self#run_script ()
|
||||
else
|
||||
raise (Chat_match (inbuf_str, Regex buf))
|
||||
else
|
||||
()
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -156,11 +177,11 @@ let chat script proc =
|
|||
Unixqueue.run ues;
|
||||
with
|
||||
| Chat_match (got, expected) ->
|
||||
raise (Failure ("Not matched: got " ^
|
||||
(string_of_chat_event got) ^
|
||||
", expected " ^
|
||||
(string_of_chat_event expected)))
|
||||
raise (Failure ("Not matched: got " ^
|
||||
(String.escaped got) ^
|
||||
", expected " ^
|
||||
(string_of_chat_event expected)))
|
||||
| Chat_timeout evt ->
|
||||
raise (Failure ("Timeout waiting for " ^
|
||||
(string_of_chat_event evt)))
|
||||
raise (Failure ("Timeout waiting for " ^
|
||||
(string_of_chat_event evt)))
|
||||
|
||||
|
|
|
|||
151
client.ml
151
client.ml
|
|
@ -35,12 +35,109 @@ let close cli ues g fd =
|
|||
let write cli cmd =
|
||||
Iobuf.write cli.iobuf cmd
|
||||
|
||||
let reply cli num text =
|
||||
let reply cli num ?(args=[]) text =
|
||||
write cli (Command.create
|
||||
(Some !(Irc.name)) num [!(cli.nick)] (Some text))
|
||||
(Some !(Irc.name))
|
||||
num
|
||||
([!(cli.nick)] @ args)
|
||||
(Some text))
|
||||
|
||||
let handle_command cli iobuf cmd =
|
||||
write cli cmd
|
||||
match (Command.as_tuple cmd) with
|
||||
| (None, "OPER", [name; password], None) ->
|
||||
()
|
||||
| (None, "MODE", target :: args, None) ->
|
||||
()
|
||||
| (None, "SERVICE", [nickname; _; distribution; svctype; _], Some info) ->
|
||||
()
|
||||
| (None, "QUIT", [], message) ->
|
||||
()
|
||||
| (None, "JOIN", ["0"], None) ->
|
||||
()
|
||||
| (None, "JOIN", [channels], None) ->
|
||||
()
|
||||
| (None, "JOIN", [channels; keys], None) ->
|
||||
()
|
||||
| (None, "PART", [channels], message) ->
|
||||
()
|
||||
| (None, "TOPIC", [channel], None) ->
|
||||
()
|
||||
| (None, "TOPIC", [channel], Some topic) ->
|
||||
()
|
||||
| (None, "NAMES", [channels], None) ->
|
||||
()
|
||||
| (None, "LIST", [channels], None) ->
|
||||
()
|
||||
| (None, "INVITE", [nickname; channel], None) ->
|
||||
()
|
||||
| (None, "KICK", [channels; users], comment) ->
|
||||
()
|
||||
| (None, "PRIVMSG", [target], Some text) ->
|
||||
()
|
||||
| (None, "NOTICE", [target], Some text) ->
|
||||
()
|
||||
| (None, "MOTD", [], None) ->
|
||||
reply cli "422" "MOTD File is missing"
|
||||
| (None, "LUSERS", [], None) ->
|
||||
()
|
||||
| (None, "VERSION", [], None) ->
|
||||
reply cli "351" ~args:[Irc.version; !(Irc.name)] ""
|
||||
| (None, "STATS", [], None) ->
|
||||
()
|
||||
| (None, "TIME", [], None) ->
|
||||
let now = Unix.gmtime (Unix.time ()) in
|
||||
let timestr =
|
||||
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
|
||||
(now.Unix.tm_year + 1900)
|
||||
now.Unix.tm_mday
|
||||
(match now.Unix.tm_mon with
|
||||
| 0 -> 12
|
||||
| mon -> mon)
|
||||
now.Unix.tm_hour
|
||||
now.Unix.tm_min
|
||||
now.Unix.tm_sec
|
||||
in
|
||||
reply cli "391" ~args:[!(Irc.name)] timestr;
|
||||
| (None, "ADMIN", [], None) ->
|
||||
()
|
||||
| (None, "INFO", [], None) ->
|
||||
()
|
||||
| (None, "SERVLIST", [], None) ->
|
||||
()
|
||||
| (None, "SQUERY", [servicename], Some text) ->
|
||||
()
|
||||
| (None, "WHO", [], None) ->
|
||||
()
|
||||
| (None, "WHO", [mask], None) ->
|
||||
()
|
||||
| (None, "WHO", [mask; "o"], None) ->
|
||||
()
|
||||
| (None, "WHIOS", [masks], None) ->
|
||||
()
|
||||
| (None, "KILL", [nickname; comment], None) ->
|
||||
()
|
||||
| (None, "PING", [server], None) ->
|
||||
()
|
||||
| (None, "PONG", [server], None) ->
|
||||
()
|
||||
| (None, "ERROR", [], Some message) ->
|
||||
()
|
||||
| (None, "AWAY", [], None) ->
|
||||
()
|
||||
| (None, "AWAY", [], Some message) ->
|
||||
()
|
||||
| (None, "REHASH", [], None) ->
|
||||
()
|
||||
| (None, "DIE", [], None) ->
|
||||
()
|
||||
| (None, "RESTART", [], None) ->
|
||||
()
|
||||
| (None, "WALLOPS", [], Some text) ->
|
||||
()
|
||||
| (None, "ISON", nicks, None) ->
|
||||
()
|
||||
| (_, name, _, _) ->
|
||||
reply cli "421" ~args:[name] "Unknown or misconstructed command"
|
||||
|
||||
let set_nick cli nick =
|
||||
if Hashtbl.mem by_nick nick then
|
||||
|
|
@ -54,50 +151,50 @@ let rec handle_command_prereg (nick', username', realname', password') iobuf cmd
|
|||
let acc =
|
||||
match (Command.as_tuple cmd) with
|
||||
| (None, "PASS", [password], None) ->
|
||||
(nick', username', realname', Some password)
|
||||
(nick', username', realname', Some password)
|
||||
| (None, "USER", [username; _; _], Some realname) ->
|
||||
(nick', Some username, Some (Irc.truncate realname 40), password')
|
||||
(nick', Some username, Some (Irc.truncate realname 40), password')
|
||||
| (None, "NICK", [nick], None) ->
|
||||
(Some nick, username', realname', password')
|
||||
(Some nick, username', realname', password')
|
||||
| _ ->
|
||||
Iobuf.write iobuf (Command.create
|
||||
(Some !(Irc.name))
|
||||
"451" ["*"]
|
||||
(Some "Register first."));
|
||||
(nick', username', realname', password')
|
||||
(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);
|
||||
" Running version " ^ Irc.version);
|
||||
reply cli "003" "This server was created sometime";
|
||||
reply cli "004" (!(Irc.name) ^
|
||||
" " ^ Irc.version ^
|
||||
" " ^ modes ^
|
||||
" " ^ Channel.modes);
|
||||
" " ^ 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}
|
||||
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.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)
|
||||
Iobuf.rebind iobuf (handle_command_prereg acc)
|
||||
|
||||
let create_command_handler () =
|
||||
handle_command_prereg (None, None, None, None)
|
||||
|
|
|
|||
11
tests.ml
11
tests.ml
|
|
@ -48,8 +48,15 @@ let regression_tests =
|
|||
[
|
||||
"Simple connection" >::
|
||||
(do_chat ((do_login "nick") @
|
||||
[Send "WELCOME :datacomp\r\n";
|
||||
Recv "WELCOME :datacomp\r\n"]));
|
||||
[Send "BLARGH\r\n";
|
||||
Recv ":testserver.test 421 nick BLARGH :Unknown or misconstructed command\r\n";
|
||||
Send "MOTD\r\n";
|
||||
Recv ":testserver.test 422 nick :MOTD File is missing\r\n";
|
||||
Send "TIME\r\n";
|
||||
Regex ":testserver\\.test 391 nick testserver\\.test :[-0-9]+T[:0-9]+Z\r\n";
|
||||
Send "VERSION\r\n";
|
||||
Recv ":testserver.test 351 nick 0.1 testserver.test :\r\n";
|
||||
]));
|
||||
]
|
||||
|
||||
let _ =
|
||||
|
|
|
|||
Loading…
Reference in New Issue