Skeleton for all IRC commands, implemented a few, add (chat.Regex of string)

This commit is contained in:
Neale Pickett 2008-03-06 13:54:16 -07:00
parent e417d92995
commit ac369d30c2
3 changed files with 218 additions and 93 deletions

35
chat.ml
View File

@ -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
View File

@ -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

View File

@ -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 _ =