Skeleton for all IRC commands, implemented a few, add (chat.Regex of string)

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 =
@@ -132,11 +137,27 @@ object (self)
                   self#run_script ()
                 end
               else
-		raise (Chat_match (Recv inbuf_str,
+                raise (Chat_match (inbuf_str, Recv buf))
-				   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
 
 
@@ -157,7 +178,7 @@ let chat script proc =
     with
       | Chat_match (got, expected) ->
           raise (Failure ("Not matched: got " ^
-			    (string_of_chat_event got) ^
+                            (String.escaped got) ^
                             ", expected " ^
                             (string_of_chat_event expected)))
       | Chat_timeout evt ->

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

tests.ml

@@ -48,8 +48,15 @@ let regression_tests =
     [
       "Simple connection" >::
 	(do_chat ((do_login "nick") @
-		    [Send "WELCOME :datacomp\r\n";
+		    [Send "BLARGH\r\n";
-		     Recv "WELCOME :datacomp\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 _ =