From b55baf1e92c2e1ea24cc49428812286b596c88bb Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Sun, 2 Mar 2008 21:30:37 -0700 Subject: [PATCH] Setup working, now there's a bug in command parsing (again). --- channel.ml | 2 ++ channel.mli | 2 ++ client.ml | 64 ++++++++++++++++++++++++++++++++--------------------- command.ml | 4 +++- command.mli | 2 +- irc.ml | 1 + irc.mli | 2 ++ tests.ml | 35 ++++++++++++++++------------- 8 files changed, 70 insertions(+), 42 deletions(-) diff --git a/channel.ml b/channel.ml index b3dffcb..870bb51 100644 --- a/channel.ml +++ b/channel.ml @@ -1,5 +1,7 @@ type t = {name: string} +let modes = "t" + let by_name = Hashtbl.create 25 let lookup name = diff --git a/channel.mli b/channel.mli index 449b489..4691d8b 100644 --- a/channel.mli +++ b/channel.mli @@ -1,4 +1,6 @@ type t +val modes : string + val create : string -> t val lookup : string -> t diff --git a/client.ml b/client.ml index a8eb9f5..6fb2a75 100644 --- a/client.ml +++ b/client.ml @@ -8,11 +8,13 @@ type t = {outq: Command.t Queue.t; ibuf: string; ibuf_len: int ref; output_ready: unit -> unit; - handle_command: t -> Command.t -> unit; + handle_command: (t -> Command.t -> unit) ref; nick: string ref; username: string ref; realname: string ref} +let modes = "l" + let dbg msg a = prerr_endline msg; a let by_file_descr = Hashtbl.create 25 @@ -47,31 +49,43 @@ let write cli cmd = let handle_close cli = () -let handle_command cli command = - () +let handle_command cli cmd = + write cli cmd let handle_command_login cli cmd = (* Handle a command during the login phase *) - (match (Command.as_tuple cmd) with - | (None, "USER", [username; _; _], Some realname) -> - cli.username := username; - cli.realname := Irc.truncate realname 40 - | (None, "NICK", [nick], None) -> - cli.nick := nick; - | _ -> - write cli (Command.create - ~sender:(Some !Irc.name) - ~text:(Some "Register first.") - "451" ["*"])); - (match (!(cli.username), !(cli.nick)) with - | ("", _) - | (_, "") -> - () - | (_, nick) -> - write cli (Command.create - ~sender:(Some !Irc.name) - ~text:(Some "Welcome to IRC.") - "001" [nick])) + begin + match (Command.as_tuple cmd) with + | (None, "USER", [username; _; _], Some realname) -> + cli.username := username; + cli.realname := Irc.truncate realname 40 + | (None, "NICK", [nick], None) -> + cli.nick := nick; + | _ -> + write cli (Command.create + (Some !Irc.name) "451" ["*"] (Some "Register first.")) + end; + match (!(cli.username), !(cli.nick)) with + | ("", _) + | (_, "") -> + () + | (_, nick) -> + cli.handle_command := handle_command; + let command name text = + write cli (Command.create + (Some !(Irc.name)) + name + [nick] + (Some text)) + in + command "001" "Welcome to IRC."; + command "002" ("I am " ^ !(Irc.name) ^ + " running version " ^ Irc.version); + command "003" "This server was created sometime"; + command "004" (!(Irc.name) ^ + " " ^ Irc.version ^ + " " ^ modes ^ + " " ^ Channel.modes) let crlf = Str.regexp "\r?\n" @@ -86,7 +100,7 @@ let handle_input cli = String.blit leftover 0 cli.ibuf 0 (String.length leftover) | line :: tl -> let parsed = Command.from_string line in - cli.handle_command cli parsed; + !(cli.handle_command) cli parsed; loop tl in loop lines @@ -145,7 +159,7 @@ let create ues g fd = begin fun () -> Unixqueue.add_resource ues g (Unixqueue.Wait_out fd, -.1.0) end; - handle_command = handle_command_login; + handle_command = ref handle_command_login; nick = ref ""; username = ref ""; realname = ref ""} diff --git a/command.ml b/command.ml index cbaaf5c..24808c5 100644 --- a/command.ml +++ b/command.ml @@ -3,12 +3,14 @@ type t = {sender: string option; args: string list; text: string option} -let create ?(sender=None) ?(text=None) name args = +let create sender name args text = {sender = sender; name = name; args = args; text = text} +let anon = create None + let as_string cmd = let ret = Buffer.create 120 in (match cmd.sender with diff --git a/command.mli b/command.mli index 736db51..d8e1fd7 100644 --- a/command.mli +++ b/command.mli @@ -1,6 +1,6 @@ type t -val create : ?sender:string option -> ?text:string option -> string -> string list -> t +val create : string option -> string -> string list -> string option -> t val from_string : string -> t val as_string : t -> string val as_tuple : t -> (string option * string * string list * string option) diff --git a/irc.ml b/irc.ml index 50308b7..cdd35ce 100644 --- a/irc.ml +++ b/irc.ml @@ -1,4 +1,5 @@ let name = ref "irc.test" +let version = "0.1" let newline_re = Pcre.regexp "\n\r?" let argsep_re = Pcre.regexp " :" diff --git a/irc.mli b/irc.mli index 76e5329..06d5536 100644 --- a/irc.mli +++ b/irc.mli @@ -1,4 +1,6 @@ val name : string ref +val version : string + val uppercase : string -> string val lowercase : string -> string val truncate : string -> int -> string diff --git a/tests.ml b/tests.ml index 9d12441..04ac176 100644 --- a/tests.ml +++ b/tests.ml @@ -19,36 +19,41 @@ let unit_tests = (fun () -> assert_equal ~printer:Command.as_string - (Command.create "NICK" ["name"]) + (Command.create None "NICK" ["name"] None) (Command.from_string "NICK name"); assert_equal ~printer:Command.as_string - (Command.create ~sender:(Some "foo") "NICK" ["name"]) + (Command.create (Some "foo") "NICK" ["name"] None) (Command.from_string ":foo NICK name"); assert_equal ~printer:Command.as_string (Command.create - ~sender:(Some "foo.bar") - ~text:(Some "ta ta") - "PART" ["#foo"; "#bar"]) + (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 = - let login_script nick = + "Regression tests" >::: [ - Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n"); - Send ("NICK " ^ nick ^ "\r\n"); - Recv (":testserver.test 001 " ^ nick ^ " :Welcome to IRC.\r\n"); + "Simple connection" >:: + (do_chat ((do_login "nick") @ + [Send "WELCOME :datacomp\r\n"; + Recv "WELCOME :datacomp\r\n"])); ] - in - "Regression tests" >::: - [ - "Simple connection" >:: - (do_chat (login_script "nick")); - ] let _ = Irc.name := "testserver.test";