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} type t = {name: string}
let modes = "t"
let by_name = Hashtbl.create 25 let by_name = Hashtbl.create 25
let lookup name = let lookup name =

View File

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

View File

@ -8,11 +8,13 @@ type t = {outq: Command.t Queue.t;
ibuf: string; ibuf: string;
ibuf_len: int ref; ibuf_len: int ref;
output_ready: unit -> unit; output_ready: unit -> unit;
handle_command: t -> Command.t -> unit; handle_command: (t -> Command.t -> unit) ref;
nick: string ref; nick: string ref;
username: string ref; username: string ref;
realname: string ref} realname: string ref}
let modes = "l"
let dbg msg a = prerr_endline msg; a let dbg msg a = prerr_endline msg; a
let by_file_descr = Hashtbl.create 25 let by_file_descr = Hashtbl.create 25
@ -47,12 +49,13 @@ let write cli cmd =
let handle_close cli = let handle_close cli =
() ()
let handle_command cli command = let handle_command cli cmd =
() write cli cmd
let handle_command_login cli cmd = let handle_command_login cli cmd =
(* Handle a command during the login phase *) (* Handle a command during the login phase *)
(match (Command.as_tuple cmd) with begin
match (Command.as_tuple cmd) with
| (None, "USER", [username; _; _], Some realname) -> | (None, "USER", [username; _; _], Some realname) ->
cli.username := username; cli.username := username;
cli.realname := Irc.truncate realname 40 cli.realname := Irc.truncate realname 40
@ -60,18 +63,29 @@ let handle_command_login cli cmd =
cli.nick := nick; cli.nick := nick;
| _ -> | _ ->
write cli (Command.create write cli (Command.create
~sender:(Some !Irc.name) (Some !Irc.name) "451" ["*"] (Some "Register first."))
~text:(Some "Register first.") end;
"451" ["*"])); match (!(cli.username), !(cli.nick)) with
(match (!(cli.username), !(cli.nick)) with
| ("", _) | ("", _)
| (_, "") -> | (_, "") ->
() ()
| (_, nick) -> | (_, nick) ->
cli.handle_command := handle_command;
let command name text =
write cli (Command.create write cli (Command.create
~sender:(Some !Irc.name) (Some !(Irc.name))
~text:(Some "Welcome to IRC.") name
"001" [nick])) [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" let crlf = Str.regexp "\r?\n"
@ -86,7 +100,7 @@ let handle_input cli =
String.blit leftover 0 cli.ibuf 0 (String.length leftover) String.blit leftover 0 cli.ibuf 0 (String.length leftover)
| line :: tl -> | line :: tl ->
let parsed = Command.from_string line in let parsed = Command.from_string line in
cli.handle_command cli parsed; !(cli.handle_command) cli parsed;
loop tl loop tl
in in
loop lines loop lines
@ -145,7 +159,7 @@ let create ues g fd =
begin begin
fun () -> Unixqueue.add_resource ues g (Unixqueue.Wait_out fd, -.1.0) fun () -> Unixqueue.add_resource ues g (Unixqueue.Wait_out fd, -.1.0)
end; end;
handle_command = handle_command_login; handle_command = ref handle_command_login;
nick = ref ""; nick = ref "";
username = ref ""; username = ref "";
realname = ref ""} realname = ref ""}

View File

@ -3,12 +3,14 @@ type t = {sender: string option;
args: string list; args: string list;
text: string option} text: string option}
let create ?(sender=None) ?(text=None) name args = let create sender name args text =
{sender = sender; {sender = sender;
name = name; name = name;
args = args; args = args;
text = text} text = text}
let anon = create None
let as_string cmd = let as_string cmd =
let ret = Buffer.create 120 in let ret = Buffer.create 120 in
(match cmd.sender with (match cmd.sender with

View File

@ -1,6 +1,6 @@
type t 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 from_string : string -> t
val as_string : t -> string val as_string : t -> string
val as_tuple : t -> (string option * string * string list * string option) 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 name = ref "irc.test"
let version = "0.1"
let newline_re = Pcre.regexp "\n\r?" let newline_re = Pcre.regexp "\n\r?"
let argsep_re = Pcre.regexp " :" let argsep_re = Pcre.regexp " :"

View File

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

View File

@ -19,35 +19,40 @@ let unit_tests =
(fun () -> (fun () ->
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create "NICK" ["name"]) (Command.create None "NICK" ["name"] None)
(Command.from_string "NICK name"); (Command.from_string "NICK name");
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create ~sender:(Some "foo") "NICK" ["name"]) (Command.create (Some "foo") "NICK" ["name"] None)
(Command.from_string ":foo NICK name"); (Command.from_string ":foo NICK name");
assert_equal assert_equal
~printer:Command.as_string ~printer:Command.as_string
(Command.create (Command.create
~sender:(Some "foo.bar") (Some "foo.bar")
~text:(Some "ta ta") "PART" ["#foo"; "#bar"]
"PART" ["#foo"; "#bar"]) (Some "ta ta"))
(Command.from_string ":foo.bar PART #foo #bar :ta ta"); (Command.from_string ":foo.bar PART #foo #bar :ta ta");
) )
] ]
let regression_tests = let do_login nick =
let login_script nick =
[ [
Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n"); Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n");
Send ("NICK " ^ nick ^ "\r\n"); Send ("NICK " ^ nick ^ "\r\n");
Recv (":testserver.test 001 " ^ nick ^ " :Welcome to IRC.\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");
] ]
in
let regression_tests =
"Regression tests" >::: "Regression tests" >:::
[ [
"Simple connection" >:: "Simple connection" >::
(do_chat (login_script "nick")); (do_chat ((do_login "nick") @
[Send "WELCOME :datacomp\r\n";
Recv "WELCOME :datacomp\r\n"]));
] ]
let _ = let _ =