neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
chat.ml
View File

@ -5,16 +5,21 @@ exception Buffer_overrun
type chat_event = type chat_event =
| Send of string | Send of string
| Recv 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 exception Chat_timeout of chat_event
let dbg msg a = prerr_endline msg; a
let string_of_chat_event e = let string_of_chat_event e =
match e with match e with
| Send str -> | Send str ->
("Send(\"" ^ (String.escaped str) ^ "\")") ("Send (\"" ^ (String.escaped str) ^ "\")")
| Recv str -> | Recv str ->
("Recv(\"" ^ (String.escaped str) ^ "\")") ("Recv (\"" ^ (String.escaped str) ^ "\")")
| Regex str ->
("Regex (\"" ^ (String.escaped str) ^ "\")")
(** Return true if str starts with substr *) (** Return true if str starts with substr *)
let startswith str substr = let startswith str substr =
@ -64,7 +69,7 @@ object (self)
method write data = method write data =
let data_len = String.length data in let data_len = String.length data in
if (data_len + obuf_len > output_max) then if (data_len + obuf_len > output_max) then
raise Buffer_overrun; raise Buffer_overrun;
String.blit data 0 obuf obuf_len data_len; String.blit data 0 obuf obuf_len data_len;
obuf_len <- obuf_len + data_len; obuf_len <- obuf_len + data_len;
ues#add_resource g (Wait_out fd, output_timeout) ues#add_resource g (Wait_out fd, output_timeout)
@ -72,71 +77,87 @@ object (self)
method handle_event ues esys e = method handle_event ues esys e =
match e with match e with
| Input_arrived (g, fd) -> | Input_arrived (g, fd) ->
let data = String.create input_max in let data = String.create input_max in
let len = Unix.read fd data 0 input_max in let len = Unix.read fd data 0 input_max in
if (len > 0) then if (len > 0) then
begin begin
Buffer.add_string inbuf (String.sub data 0 len); Buffer.add_string inbuf (String.sub data 0 len);
self#run_script () self#run_script ()
end end
else else
begin begin
Unix.close fd; Unix.close fd;
ues#clear g; ues#clear g;
end end
| Output_readiness (g, fd) -> | Output_readiness (g, fd) ->
let size = obuf_len in let size = obuf_len in
let n = Unix.single_write fd obuf 0 size in let n = Unix.single_write fd obuf 0 size in
obuf_len <- obuf_len - n; obuf_len <- obuf_len - n;
if (obuf_len = 0) then if (obuf_len = 0) then
(* Don't check for output readiness anymore *) (* Don't check for output readiness anymore *)
begin begin
ues#remove_resource g (Wait_out fd) ues#remove_resource g (Wait_out fd)
end end
else else
(* Put unwritten output back into the output queue *) (* Put unwritten output back into the output queue *)
begin begin
String.blit obuf n obuf 0 (obuf_len) String.blit obuf n obuf 0 (obuf_len)
end end
| Out_of_band (g, fd) -> | Out_of_band (g, fd) ->
raise (Failure "Out of band data") raise (Failure "Out of band data")
| Timeout (g, op) -> | Timeout (g, op) ->
raise (Chat_timeout (List.hd script)) raise (Chat_timeout (List.hd script))
| Signal -> | Signal ->
raise (Failure "Signal") raise (Failure "Signal")
| Extra exn -> | Extra exn ->
raise (Failure "Extra") raise (Failure "Extra")
method run_script () = method run_script () =
match script with match script with
| [] -> | [] ->
Unix.close fd; Unix.close fd;
ues#clear g ues#clear g
| Send buf :: tl -> | Send buf :: tl ->
self#write buf; self#write buf;
script <- tl; script <- tl;
self#run_script () self#run_script ()
| Recv buf :: tl -> | Recv buf :: tl ->
let buf_len = String.length buf in let buf_len = String.length buf in
let inbuf_str = Buffer.contents inbuf in let inbuf_str = Buffer.contents inbuf in
if (Buffer.length inbuf >= buf_len) then if (Buffer.length inbuf >= buf_len) then
if startswith inbuf_str buf then if startswith inbuf_str buf then
begin begin
script <- tl; script <- tl;
Buffer.clear inbuf; Buffer.clear inbuf;
Buffer.add_substring Buffer.add_substring
inbuf inbuf
inbuf_str inbuf_str
buf_len buf_len
((String.length inbuf_str) - buf_len); ((String.length inbuf_str) - buf_len);
self#run_script () self#run_script ()
end end
else else
raise (Chat_match (Recv inbuf_str, raise (Chat_match (inbuf_str, Recv buf))
Recv buf)) else
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 end
@ -156,11 +177,11 @@ let chat script proc =
Unixqueue.run ues; Unixqueue.run ues;
with with
| Chat_match (got, expected) -> | Chat_match (got, expected) ->
raise (Failure ("Not matched: got " ^ raise (Failure ("Not matched: got " ^
(string_of_chat_event got) ^ (String.escaped got) ^
", expected " ^ ", expected " ^
(string_of_chat_event expected))) (string_of_chat_event expected)))
| Chat_timeout evt -> | Chat_timeout evt ->
raise (Failure ("Timeout waiting for " ^ raise (Failure ("Timeout waiting for " ^
(string_of_chat_event evt))) (string_of_chat_event evt)))

151
client.ml
View File

@ -35,12 +35,109 @@ let close cli ues g fd =
let write cli cmd = let write cli cmd =
Iobuf.write cli.iobuf cmd Iobuf.write cli.iobuf cmd
let reply cli num text = let reply cli num ?(args=[]) text =
write cli (Command.create 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 = 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 = let set_nick cli nick =
if Hashtbl.mem by_nick nick then if Hashtbl.mem by_nick nick then
@ -54,50 +151,50 @@ let rec handle_command_prereg (nick', username', realname', password') iobuf cmd
let acc = let acc =
match (Command.as_tuple cmd) with match (Command.as_tuple cmd) with
| (None, "PASS", [password], None) -> | (None, "PASS", [password], None) ->
(nick', username', realname', Some password) (nick', username', realname', Some password)
| (None, "USER", [username; _; _], Some realname) -> | (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) -> | (None, "NICK", [nick], None) ->
(Some nick, username', realname', password') (Some nick, username', realname', password')
| _ -> | _ ->
Iobuf.write iobuf (Command.create Iobuf.write iobuf (Command.create
(Some !(Irc.name)) (Some !(Irc.name))
"451" ["*"] "451" ["*"]
(Some "Register first.")); (Some "Register first."));
(nick', username', realname', password') (nick', username', realname', password')
in in
let welcome cli = let welcome cli =
try try
set_nick cli !(cli.nick); set_nick cli !(cli.nick);
reply cli "001" "Welcome to IRC."; reply cli "001" "Welcome to IRC.";
reply cli "002" ("I am " ^ !(Irc.name) ^ 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 "003" "This server was created sometime";
reply cli "004" (!(Irc.name) ^ reply cli "004" (!(Irc.name) ^
" " ^ Irc.version ^ " " ^ Irc.version ^
" " ^ modes ^ " " ^ modes ^
" " ^ Channel.modes); " " ^ Channel.modes);
Iobuf.rebind iobuf (handle_command cli) Iobuf.rebind iobuf (handle_command cli)
with Error cmd -> with Error cmd ->
Iobuf.write iobuf cmd Iobuf.write iobuf cmd
in in
match acc with match acc with
| (Some nick, Some username, Some realname, None) -> | (Some nick, Some username, Some realname, None) ->
welcome {iobuf = iobuf; welcome {iobuf = iobuf;
nick = ref nick; nick = ref nick;
username = username; username = username;
realname = realname} realname = realname}
| (Some nick, Some username, Some realname, Some password) -> | (Some nick, Some username, Some realname, Some password) ->
Iobuf.write iobuf (Command.create Iobuf.write iobuf (Command.create
(Some !(Irc.name)) (Some !(Irc.name))
"NOTICE" ["AUTH"] "NOTICE" ["AUTH"]
(Some "*** Authentication unimplemented")); (Some "*** Authentication unimplemented"));
welcome {iobuf = iobuf; welcome {iobuf = iobuf;
nick = ref nick; nick = ref nick;
username = username; username = username;
realname = realname} realname = realname}
| _ -> | _ ->
Iobuf.rebind iobuf (handle_command_prereg acc) Iobuf.rebind iobuf (handle_command_prereg acc)
let create_command_handler () = let create_command_handler () =
handle_command_prereg (None, None, None, None) handle_command_prereg (None, None, None, None)

11
tests.ml
View File

@ -48,8 +48,15 @@ let regression_tests =
[ [
"Simple connection" >:: "Simple connection" >::
(do_chat ((do_login "nick") @ (do_chat ((do_login "nick") @
[Send "WELCOME :datacomp\r\n"; [Send "BLARGH\r\n";
Recv "WELCOME :datacomp\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 _ = let _ =