Setup working, now there's a bug in command parsing (again).

This commit is contained in:
Neale Pickett 2008-03-02 21:30:37 -07:00
parent 4f6ba7f271
commit b55baf1e92
8 changed files with 70 additions and 42 deletions

View File

@ -1,5 +1,7 @@
type t = {name: string}
let modes = "t"
let by_name = Hashtbl.create 25
let lookup name =

View File

@ -1,4 +1,6 @@
type t
val modes : string
val create : string -> t
val lookup : string -> t

View File

@ -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 ""}

View File

@ -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

View File

@ -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)

1
irc.ml
View File

@ -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 " :"

View File

@ -1,4 +1,6 @@
val name : string ref
val version : string
val uppercase : string -> string
val lowercase : string -> string
val truncate : string -> int -> string

View File

@ -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";