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
35
chat.ml
35
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 =
|
||||
|
@ -132,11 +137,27 @@ object (self)
|
|||
self#run_script ()
|
||||
end
|
||||
else
|
||||
raise (Chat_match (Recv inbuf_str,
|
||||
Recv buf))
|
||||
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
|
||||
|
||||
|
||||
|
@ -157,7 +178,7 @@ let chat script proc =
|
|||
with
|
||||
| Chat_match (got, expected) ->
|
||||
raise (Failure ("Not matched: got " ^
|
||||
(string_of_chat_event got) ^
|
||||
(String.escaped got) ^
|
||||
", expected " ^
|
||||
(string_of_chat_event expected)))
|
||||
| Chat_timeout evt ->
|
||||
|
|
103
client.ml
103
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
|
||||
|
|
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