From 167105c6616cc4e120b5c08d6797ae2186980a4a Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Tue, 18 Mar 2008 22:50:23 -0600 Subject: [PATCH] Add AWAY, ERROR, and INFO commands --- OMakefile | 24 ++++++++++++------------ client.ml | 25 ++++++++++++++----------- irc.ml | 1 + irc.mli | 1 + tests.ml | 15 +++++++++++++-- 5 files changed, 41 insertions(+), 25 deletions(-) diff --git a/OMakefile b/OMakefile index 08faa8d..9306e70 100644 --- a/OMakefile +++ b/OMakefile @@ -10,21 +10,21 @@ StaticCLibrary(ocamlepoll, epoll_wrapper) OCamlProgram(ircd, ircd irc command iobuf dispatch client channel) section - OCAMLPACKS[] += - oUnit - NATIVE_ENABLED = false + OCAMLPACKS[] += + oUnit + NATIVE_ENABLED = false - tests.cmx: - tests.cmi: - tests.cmo: - tests$(EXT_OBJ): + tests.cmx: + tests.cmi: + tests.cmo: + tests$(EXT_OBJ): - dispatch_tests.cmx: - dispatch_tests.cmi: - dispatch_tests.cmo: - dispatch_tests$(EXT_OBJ): + dispatch_tests.cmx: + dispatch_tests.cmi: + dispatch_tests.cmo: + dispatch_tests$(EXT_OBJ): - OCamlProgram(tests, tests dispatch irc command iobuf client channel) + OCamlProgram(tests, tests dispatch irc command iobuf client channel) .PHONY: test test: tests diff --git a/client.ml b/client.ml index 8a3ceb2..5df3883 100644 --- a/client.ml +++ b/client.ml @@ -1,12 +1,11 @@ open Irc - - (* ========================================== * Client stuff *) type t = {iobuf: Iobuf.t; nick: string ref; + away: string option ref; username: string; realname: string} @@ -113,7 +112,9 @@ let handle_command cli iobuf cmd = | (None, "ADMIN", [], None) -> () | (None, "INFO", [], None) -> - () + reply cli "371" (Printf.sprintf "pgircd v%s" Irc.version); + reply cli "371" (Printf.sprintf "Running since %f" Irc.start_time); + reply cli "374" "End of INFO list" | (None, "SERVLIST", [], None) -> () | (None, "SQUERY", [servicename], Some text) -> @@ -132,19 +133,18 @@ let handle_command cli iobuf cmd = | (None, "PING", [text], None) -> write cli (Some !(Irc.name)) "PONG" [!(Irc.name)] (Some text) | (None, "PONG", [payload], None) -> + (* We do nothing. *) () | (None, "ERROR", [], Some message) -> - () + write cli (Some !(Irc.name)) "NOTICE" [!(cli.nick)] (Some "Bummer.") | (None, "AWAY", [], None) -> - () + cli.away := None; + reply cli "305" "You are no longer marked as being away" | (None, "AWAY", [], Some message) -> - () + cli.away := Some message; + reply cli "306" "You have been marked as being away" | (None, "REHASH", [], None) -> () - | (None, "DIE", [], None) -> - () - | (None, "RESTART", [], None) -> - () | (None, "WALLOPS", [], Some text) -> () | (None, "ISON", nicks, None) -> @@ -183,7 +183,8 @@ let rec handle_command_prereg (nick, username, realname, password) iobuf cmd = reply cli "001" "Welcome to IRC."; reply cli "002" ("I am " ^ !(Irc.name) ^ " Running version " ^ Irc.version); - reply cli "003" "This server was created sometime"; + reply cli "003" ("This server was created " ^ + (string_of_float Irc.start_time)); reply cli "004" (!(Irc.name) ^ " " ^ Irc.version ^ " " ^ modes ^ @@ -196,6 +197,7 @@ let rec handle_command_prereg (nick, username, realname, password) iobuf cmd = | (Some nick, Some username, Some realname, None) -> welcome {iobuf = iobuf; nick = ref nick; + away = ref None; username = username; realname = realname} | (Some nick, Some username, Some realname, Some password) -> @@ -205,6 +207,7 @@ let rec handle_command_prereg (nick, username, realname, password) iobuf cmd = (Some "*** Authentication unimplemented")); welcome {iobuf = iobuf; nick = ref nick; + away = ref None; username = username; realname = realname} | _ -> diff --git a/irc.ml b/irc.ml index eff55a3..b8d3ded 100644 --- a/irc.ml +++ b/irc.ml @@ -1,5 +1,6 @@ let name = ref "irc.test" let version = "0.1" +let start_time = Unix.gettimeofday () let dbg msg a = prerr_endline ("[" ^ msg ^ "]"); diff --git a/irc.mli b/irc.mli index 06d5536..3def8cb 100644 --- a/irc.mli +++ b/irc.mli @@ -1,5 +1,6 @@ val name : string ref val version : string +val start_time : float val uppercase : string -> string val lowercase : string -> string diff --git a/tests.ml b/tests.ml index 7c9edfe..d1b8f6b 100644 --- a/tests.ml +++ b/tests.ml @@ -90,7 +90,7 @@ let chat d fd s = (string_of_chat_event (List.hd !script))) in let nomatch got = - failwith (Printf.sprintf "fd=%d expecting %s\n got %s" + 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)) @@ -339,7 +339,7 @@ let do_login nick = 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 003 " ^ nick ^ " :This server was created " ^ (string_of_float Irc.start_time) ^ "\r\n"); Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l t\r\n"); ] @@ -363,6 +363,7 @@ let regression_tests = 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"; @@ -373,6 +374,16 @@ let regression_tests = 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