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

458 lines
16 KiB
OCaml
Raw Blame History

open OUnit
let dump x =
Printf.ksprintf (fun str -> prerr_string str; flush stderr) x
(* Return true iff str starts with substr *)
let startswith str substr =
let l = String.length substr in
if l > String.length str then
false
else
String.sub str 0 l = substr
(* ***************************************************
* Epoll stuff
* ***************************************************)
let int_of_file_descr fd = (Obj.magic fd) + 0
let rec epollevents_as_list events =
match events with
| [] ->
[]
| Epoll.In :: tl ->
"POLLIN" :: (epollevents_as_list tl)
| Epoll.Priority :: tl ->
"POLLPRI" :: (epollevents_as_list tl)
| Epoll.Out :: tl ->
"POLLOUT" :: (epollevents_as_list tl)
| Epoll.Error :: tl ->
"POLLERR" :: (epollevents_as_list tl)
| Epoll.Hangup :: tl ->
"POLLHUP" :: (epollevents_as_list tl)
let rec epollfds_as_list pfds =
match pfds with
| [] ->
[]
| (fd, events) :: tl ->
(Printf.sprintf "{fd=%d; events=%s}"
(int_of_file_descr fd)
(String.concat "|" (epollevents_as_list events))) ::
epollfds_as_list tl
let epollfds_as_string pfds =
"[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]"
let epollfd_as_string pfd =
epollfds_as_string [pfd]
let epoll_expect e ?(n=3) l =
let m = Epoll.wait e n 0 in
assert_equal
~printer:epollfds_as_string
(List.sort compare l)
(List.sort compare m)
(* ***************************************************
* Chat script stuff
* ***************************************************)
type chat_event =
| Send of string
| Recv of string
| Regex of string
exception Chat_match of (string * chat_event)
exception Chat_timeout of chat_event
let string_of_chat_event e =
match e with
| Send str ->
("Send (\"" ^ (String.escaped str) ^ "\")")
| Recv str ->
("Recv (\"" ^ (String.escaped str) ^ "\")")
| Regex str ->
("Regex (\"" ^ (String.escaped str) ^ "\")")
(* Return a [Dispatch.fd_handler] function to run script [s] *)
let chat d fd s =
let script = ref s in
(* Add some amount, dependent on fd, to the timeout value, so peers won't obliterate it *)
let timer = (Unix.time ()) +. 1.0 +. (0.01 *. (float_of_int (int_of_file_descr fd))) in
let obuf = Buffer.create 4096 in
let ibuf = Buffer.create 4096 in
let handle_timer _ =
failwith (Printf.sprintf "fd=%d timeout waiting for %s"
(int_of_file_descr fd)
(string_of_chat_event (List.hd !script)))
in
let nomatch got =
failwith (Printf.sprintf "fd=%d\nexpecting %s\n got %s"
(int_of_file_descr fd)
(string_of_chat_event (List.hd !script))
(String.escaped got))
in
let rec run_script fd =
match !script with
| [] ->
if ((Buffer.length obuf) = 0) then begin
Dispatch.delete_timer d timer;
(try
Dispatch.delete d fd
with (Failure _) ->
());
Unix.close fd
end
| Send buf :: tl ->
Buffer.add_string obuf buf;
Dispatch.modify d fd [Dispatch.Input; Dispatch.Output];
script := tl;
run_script fd
| Recv buf :: tl ->
let buf_len = String.length buf in
let ibuf_str = Buffer.contents ibuf in
if ((Buffer.length ibuf) >= buf_len) then begin
if startswith ibuf_str buf then begin
script := tl;
Buffer.clear ibuf;
Buffer.add_substring
ibuf
ibuf_str
buf_len
((String.length ibuf_str) - buf_len);
run_script fd
end else
nomatch ibuf_str
end else
()
| Regex buf :: tl ->
let ibuf_str = Buffer.contents ibuf in
let matched = Str.string_match (Str.regexp buf) ibuf_str 0 in
if (Buffer.length ibuf > 0) then
if matched then
let match_len = Str.match_end () in
script := tl;
Buffer.clear ibuf;
Buffer.add_substring
ibuf
ibuf_str
match_len
((String.length ibuf_str) - match_len);
run_script fd
else
nomatch ibuf_str
else
()
in
let rec handler fd events =
match events with
| [] ->
()
| Dispatch.Input :: tl ->
let s = String.create 4096 in
let n = Unix.read fd s 0 4096 in
Buffer.add_substring ibuf s 0 n;
run_script fd;
handler fd tl
| Dispatch.Output :: tl ->
begin
if ((Buffer.length obuf) = 0) then
Dispatch.modify d fd [Dispatch.Input]
else
let ostr = Buffer.contents obuf in
let olen = Buffer.length obuf in
let n = Unix.write fd ostr 0 olen in
Buffer.clear obuf;
Buffer.add_substring obuf ostr n (olen - n)
end;
handler fd tl
| Dispatch.Hangup :: tl ->
(* Stop listening to this fd, it will always return Hangup *)
(try
Dispatch.delete d fd
with (Failure _) ->
())
| _ ->
failwith "Unexpected event"
in
Dispatch.add_timer d handle_timer timer;
Dispatch.add d fd handler [Dispatch.Input];
run_script fd
(* ***************************************************
* The tests
* ***************************************************)
let unit_tests =
"Unit tests" >::: [
"Epoll" >::
(fun () ->
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let e = Epoll.create 1 in
let expect = epoll_expect e in
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out])];
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
expect [];
Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
expect [(b, [Epoll.Out])];
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
assert_equal
1
(List.length (Epoll.wait e 1 0));
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
assert_equal
2
(Unix.write a "hi" 0 2);
expect [(a, [Epoll.Out]); (b, [Epoll.In; Epoll.Out])];
Epoll.ctl e Epoll.Delete (a, []);
expect [(b, [Epoll.In; Epoll.Out])];
assert_raises
(Failure "ocaml_epoll_ctl: No such file or directory")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
assert_raises
(Failure "ocaml_epoll_ctl: File exists")
(fun () ->
Epoll.ctl e Epoll.Add (b, [Epoll.In; Epoll.Priority]));
expect [(b, [Epoll.In; Epoll.Out])];
Unix.close a;
expect [(b, [Epoll.In; Epoll.Out; Epoll.Hangup])];
assert_raises
(Failure "ocaml_epoll_ctl: Bad file descriptor")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
Unix.close b;
Epoll.destroy e
);
"Dispatch" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let last_event = ref (a, []) in
let rec handle fd events =
last_event := (fd, events)
in
let last_timer = ref 0.0 in
let handle_timer time =
last_timer := time
in
let s = String.create 4096 in
assert_equal 8 (Unix.write a "dispatch" 0 8);
Dispatch.add d b handle [Dispatch.Input; Dispatch.Output];
Dispatch.once d;
assert_equal (b, [Dispatch.Input; Dispatch.Output]) !last_event;
assert_equal 8 (Unix.read b s 0 4096);
assert_equal "dispatch" (Str.string_before s 8);
(let time = ((Unix.gettimeofday ()) +. 0.01) in
Dispatch.add_timer d handle_timer time;
Dispatch.add_timer d handle_timer ((Unix.gettimeofday ()) +. 10.0);
assert_equal ~printer:string_of_float 0.0 !last_timer;
Dispatch.once d;
assert_equal ~printer:string_of_float 0.0 !last_timer;
Dispatch.modify d b [Dispatch.Input];
Dispatch.once d;
if (!last_timer = 0.0) then
(* Give it one chance *)
Dispatch.once d;
assert_equal ~printer:string_of_float time !last_timer;
Dispatch.modify d b [Dispatch.Input; Dispatch.Output];
assert_equal 6 (Unix.write a "gnarly" 0 6);
Dispatch.once d;
assert_equal (b, [Dispatch.Input; Dispatch.Output]) !last_event;
assert_equal 6 (Unix.read b s 0 4096);
assert_equal ~printer:string_of_float time !last_timer);
Dispatch.once d;
assert_equal (b, [Dispatch.Output]) !last_event;
Dispatch.destroy d;
Unix.close a;
Unix.close b
);
"command_of_string" >::
(fun () ->
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "NICK name");
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "nick name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo") "NICK" ["name"] None)
(Command.from_string ":foo NICK name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo.bar") "PART" ["#foo"; "#bar"]
(Some "ta ta"))
(Command.from_string ":foo.bar PART #foo #bar :ta ta");
);
"Chat test" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
chat d a
[Send "banner";
Recv "hi";
Send "ehlo there, pleased to meet you"];
chat d b
[Recv "banner";
Send "hi";
Regex "ehlo .* you"];
Dispatch.run d;
);
]
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 003 " ^ nick ^ " :This server was created " ^ (string_of_float Irc.start_time) ^ "\r\n");
Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l aimnqpsrtklb\r\n");
]
let regression_tests =
"Regression tests" >:::
[
"Simple connection" >::
(fun () ->
let script =
(do_login "nick") @
[
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";
Send "PING snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PING :snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PONG snot\r\n";
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 nick :nick\r\n";
Send "ISON otherguy thirdguy\r\n";
Recv ":testserver.test 303 nick :\r\n";
Send "PRIVMSG nick :hello\r\n";
Recv ":nick!nick@UDS PRIVMSG nick :hello\r\n";
Send "NOTICE nick :hello\r\n";
Recv ":nick!nick@UDS NOTICE nick :hello\r\n";
Send "PRIVMSG otherguy :hello\r\n";
Recv ":testserver.test 401 nick otherguy :No such nick/channel\r\n";
Send "AWAY :eating biscuits\r\n";
Recv ":testserver.test 306 nick :You have been marked as being away\r\n";
Send "AWAY\r\n";
Recv ":testserver.test 305 nick :You are no longer marked as being away\r\n";
Send "ERROR :I peed my pants\r\n";
Recv ":testserver.test NOTICE nick :Bummer.\r\n";
Send "INFO\r\n";
Recv (":testserver.test 371 nick :pgircd v" ^ Irc.version ^ "\r\n");
Recv (Printf.sprintf ":testserver.test 371 nick :Running since %f\r\n" Irc.start_time);
Recv ":testserver.test 374 nick :End of INFO list\r\n";
]
in
let d = Dispatch.create 2 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d a (Unix.getpeername a);
chat d b script;
Dispatch.run d);
"Second connection" >::
(fun () ->
let script =
(do_login "otherguy") @
[
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 otherguy :otherguy\r\n";
]
in
let d = Dispatch.create 2 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d a (Unix.getpeername a);
chat d b script;
Dispatch.run d);
"Simultaneous connections" >::
(fun () ->
let script1 =
(do_login "alice") @
[
Send "ISON bob\r\n";
Recv ":testserver.test 303 alice :bob\r\n";
Send "PRIVMSG #foo :snot\r\n";
Recv ":testserver.test 403 alice #foo :No such channel\r\n";
Send "NOTICE #foo :snot\r\n";
Recv ":testserver.test 403 alice #foo :No such channel\r\n";
Send "JOIN #foo\r\n";
Recv ":alice!alice@UDS JOIN #foo\r\n";
Send "PRIVMSG bob :Come to #foo\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Send "PRIVMSG #foo :hello bob\r\n";
Recv ":bob!bob@UDS NOTICE #foo :hello alice\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let script2 =
(do_login "bob") @
[
Send "ISON alice charlie\r\n";
Recv ":testserver.test 303 bob :alice\r\n";
Recv ":alice!alice@UDS PRIVMSG bob :Come to #foo\r\n";
Send "JOIN #foo\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Recv ":alice!alice@UDS PRIVMSG #foo :hello bob\r\n";
Send "NOTICE #foo :hello alice\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let d = Dispatch.create 4 in
let aa,ab = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let ba,bb = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d aa (Unix.getpeername aa);
Client.handle_connection d ba (Unix.getpeername ba);
chat d ab script1;
chat d bb script2;
Dispatch.run d);
]
let _ =
Irc.name := "testserver.test";
run_test_tt_main (TestList [unit_tests; regression_tests])
Reference in New Issue View Git Blame Copy Permalink