irc-bot/tests.ml

open Unixqueue
open OUnit
open Chat
open Irc

let ues = Unixqueue.create_unix_event_system ()

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 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
	     Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
	     assert_equal
	       ~printer:epollfds_as_string
	       [(a, [Epoll.Out])]
	       (Epoll.wait e 1 0);

	     Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
	     assert_equal
	       ~printer:epollfds_as_string
	       []
	       (Epoll.wait e 1 0);

	     Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
	     assert_equal
	       ~printer:epollfds_as_string
	       [(b, [Epoll.Out])]
	       (Epoll.wait e 2 0);

	     Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
	     assert_equal
	       ~printer:epollfds_as_string
	       [(a, [Epoll.Out]); (b, [Epoll.Out])]
	       (Epoll.wait e 2 0);

	     Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
	     assert_equal
	       ~printer:epollfds_as_string
	       [(b, [Epoll.Out])]
	       (Epoll.wait e 1 0);

	     Epoll.ctl e Epoll.Delete (a, []);
	     assert_equal
	       ~printer:epollfds_as_string
	       [(b, [Epoll.Out])]
	       (Epoll.wait e 2 0);
	     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]));
	     assert_equal
	       ~printer:epollfds_as_string
	       [(b, [Epoll.Out])]
	       (Epoll.wait e 2 0);

	     Unix.close b;
	     assert_equal
	       ~printer:epollfds_as_string
	       []
	       (Epoll.wait e 2 0);
	     assert_raises 
	       (Failure "ocaml_epoll_ctl: Bad file descriptor")
	       (fun () ->
		  Epoll.ctl e Epoll.Modify (b, [Epoll.In; Epoll.Priority]));

	     Epoll.destroy e;
	     Unix.close a
	);

      "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");
	)
    ]
      


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 sometime\r\n");
    Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l t\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 "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";
               ]
           in
           let g = Unixqueue.new_group ues in
           let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
             Unixqueue.add_handler ues g Iobuf.handle_event;
             Client.handle_connection ues g a;
             ignore (new chat_handler script ues b);
             chat_run ues);

      "Second connection" >::
	(fun () ->
           let script =
             (do_login "otherguy") @
	       [
		 Send "ISON nick otherguy\r\n";
		 Recv ":testserver.test 303 otherguy :otherguy\r\n";
	       ]
           in
           let g = Unixqueue.new_group ues in
           let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
             Unixqueue.add_handler ues g Iobuf.handle_event;
             Client.handle_connection ues g a;
             ignore (new chat_handler script ues b);
             chat_run ues);

      "Simultaneous connections" >::
        (fun () ->
           let script1 =
             (do_login "alice") @
               [
                 Send "ISON bob\r\n";
                 Recv ":testserver.test 303 alice :bob\r\n";
                 Send "PRIVMSG bob :Hi Bob!\r\n";
                 Send "PING :foo\r\n";  (* Make sure we don't disconnect too soon *)
                 Recv ":testserver.test PONG testserver.test :foo\r\n";
               ]
           in
           let script2 =
             (do_login "bob") @
               [
                 Send "ISON alice\r\n";
                 Recv ":testserver.test 303 bob :alice\r\n";
                 Recv ":alice!alice@UDS PRIVMSG bob :Hi Bob!\r\n";
               ]
           in
           let g = Unixqueue.new_group ues 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
             Unixqueue.add_handler ues g Iobuf.handle_event;
             Client.handle_connection ues g aa;
             Client.handle_connection ues g ba;
             ignore (new chat_handler script1 ues ab);
             ignore (new chat_handler script2 ues bb);
             chat_run ues);
    ]

let _ =
  Irc.name := "testserver.test";
  run_test_tt_main (TestList [unit_tests; regression_tests])