diff --git a/chat.ml b/chat.ml index 57473b7..6d89c05 100644 --- a/chat.ml +++ b/chat.ml @@ -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 = @@ -64,7 +69,7 @@ object (self) method write data = let data_len = String.length data in if (data_len + obuf_len > output_max) then - raise Buffer_overrun; + raise Buffer_overrun; String.blit data 0 obuf obuf_len data_len; obuf_len <- obuf_len + data_len; ues#add_resource g (Wait_out fd, output_timeout) @@ -72,71 +77,87 @@ object (self) method handle_event ues esys e = match e with | Input_arrived (g, fd) -> - let data = String.create input_max in - let len = Unix.read fd data 0 input_max in - if (len > 0) then - begin - Buffer.add_string inbuf (String.sub data 0 len); - self#run_script () - end - else - begin - Unix.close fd; - ues#clear g; - end + let data = String.create input_max in + let len = Unix.read fd data 0 input_max in + if (len > 0) then + begin + Buffer.add_string inbuf (String.sub data 0 len); + self#run_script () + end + else + begin + Unix.close fd; + ues#clear g; + end | Output_readiness (g, fd) -> - let size = obuf_len in - let n = Unix.single_write fd obuf 0 size in - obuf_len <- obuf_len - n; - if (obuf_len = 0) then - (* Don't check for output readiness anymore *) - begin - ues#remove_resource g (Wait_out fd) - end - else - (* Put unwritten output back into the output queue *) - begin - String.blit obuf n obuf 0 (obuf_len) - end + let size = obuf_len in + let n = Unix.single_write fd obuf 0 size in + obuf_len <- obuf_len - n; + if (obuf_len = 0) then + (* Don't check for output readiness anymore *) + begin + ues#remove_resource g (Wait_out fd) + end + else + (* Put unwritten output back into the output queue *) + begin + String.blit obuf n obuf 0 (obuf_len) + end | Out_of_band (g, fd) -> - raise (Failure "Out of band data") + raise (Failure "Out of band data") | Timeout (g, op) -> - raise (Chat_timeout (List.hd script)) + raise (Chat_timeout (List.hd script)) | Signal -> - raise (Failure "Signal") + raise (Failure "Signal") | Extra exn -> - raise (Failure "Extra") + raise (Failure "Extra") method run_script () = match script with | [] -> - Unix.close fd; - ues#clear g + Unix.close fd; + ues#clear g | Send buf :: tl -> - self#write buf; - script <- tl; - self#run_script () + self#write buf; + script <- tl; + self#run_script () | Recv buf :: tl -> - let buf_len = String.length buf in - let inbuf_str = Buffer.contents inbuf in - if (Buffer.length inbuf >= buf_len) then - if startswith inbuf_str buf then - begin - script <- tl; - Buffer.clear inbuf; - Buffer.add_substring - inbuf - inbuf_str - buf_len - ((String.length inbuf_str) - buf_len); - self#run_script () - end - else - raise (Chat_match (Recv inbuf_str, - Recv buf)) - else - () - + let buf_len = String.length buf in + let inbuf_str = Buffer.contents inbuf in + if (Buffer.length inbuf >= buf_len) then + if startswith inbuf_str buf then + begin + script <- tl; + Buffer.clear inbuf; + Buffer.add_substring + inbuf + inbuf_str + buf_len + ((String.length inbuf_str) - buf_len); + self#run_script () + end + else + 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 @@ -156,11 +177,11 @@ let chat script proc = Unixqueue.run ues; with | Chat_match (got, expected) -> - raise (Failure ("Not matched: got " ^ - (string_of_chat_event got) ^ - ", expected " ^ - (string_of_chat_event expected))) + raise (Failure ("Not matched: got " ^ + (String.escaped got) ^ + ", expected " ^ + (string_of_chat_event expected))) | Chat_timeout evt -> - raise (Failure ("Timeout waiting for " ^ - (string_of_chat_event evt))) + raise (Failure ("Timeout waiting for " ^ + (string_of_chat_event evt))) diff --git a/client.ml b/client.ml index 42fbd63..45c1b07 100644 --- a/client.ml +++ b/client.ml @@ -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 @@ -54,50 +151,50 @@ let rec handle_command_prereg (nick', username', realname', password') iobuf cmd let acc = match (Command.as_tuple cmd) with | (None, "PASS", [password], None) -> - (nick', username', realname', Some password) + (nick', username', realname', Some password) | (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) -> - (Some nick, username', realname', password') + (Some nick, username', realname', password') | _ -> Iobuf.write iobuf (Command.create - (Some !(Irc.name)) - "451" ["*"] - (Some "Register first.")); - (nick', username', realname', password') + (Some !(Irc.name)) + "451" ["*"] + (Some "Register first.")); + (nick', username', realname', password') in let welcome cli = try set_nick cli !(cli.nick); reply cli "001" "Welcome to IRC."; 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 "004" (!(Irc.name) ^ - " " ^ Irc.version ^ - " " ^ modes ^ - " " ^ Channel.modes); + " " ^ Irc.version ^ + " " ^ modes ^ + " " ^ Channel.modes); Iobuf.rebind iobuf (handle_command cli) with Error cmd -> Iobuf.write iobuf cmd in match acc with | (Some nick, Some username, Some realname, None) -> - welcome {iobuf = iobuf; - nick = ref nick; - username = username; - realname = realname} + welcome {iobuf = iobuf; + nick = ref nick; + username = username; + realname = realname} | (Some nick, Some username, Some realname, Some password) -> - Iobuf.write iobuf (Command.create - (Some !(Irc.name)) - "NOTICE" ["AUTH"] - (Some "*** Authentication unimplemented")); - welcome {iobuf = iobuf; - nick = ref nick; - username = username; - realname = realname} + Iobuf.write iobuf (Command.create + (Some !(Irc.name)) + "NOTICE" ["AUTH"] + (Some "*** Authentication unimplemented")); + welcome {iobuf = iobuf; + nick = ref nick; + username = username; + realname = realname} | _ -> - Iobuf.rebind iobuf (handle_command_prereg acc) + Iobuf.rebind iobuf (handle_command_prereg acc) let create_command_handler () = handle_command_prereg (None, None, None, None) diff --git a/tests.ml b/tests.ml index e2050da..0569ca4 100644 --- a/tests.ml +++ b/tests.ml @@ -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 _ =