Convert to be a bot!

OMakefile

@@ -1,13 +1,14 @@
 OCAMLPACKS[] = 
+    unix
     str
 OCAML_CLIBS = ocamlepoll
 OCAMLCFLAGS += -g
 
-.DEFAULT: ircd
+.DEFAULT: bot
 
 StaticCLibrary(ocamlepoll, epoll_wrapper)
 
-OCamlProgram(ircd, ircd irc command iobuf dispatch client channel)
+OCamlProgram(bot, bot irc command iobuf dispatch)
 
 section
 	OCAMLPACKS[] +=

bot.ml

@@ -0,0 +1,33 @@
+let write iobuf command args text =
+  let cmd = Command.create None command args text in
+    print_endline ("--> " ^ (Command.as_string cmd));
+    Iobuf.write iobuf cmd
+
+let handle_command iobuf cmd =
+  print_endline ("<-- " ^ (Command.as_string cmd));
+  match Command.as_tuple cmd with
+    | (_, "PING", _, text) ->
+        write iobuf "PONG" [] text
+    | (_, "001", _, _) ->
+        write iobuf "JOIN" ["#bot"] None
+    | (Some who, "JOIN", [], Some chan) ->
+        write iobuf "PRIVMSG" [chan] (Some "hi asl")
+    | _ ->
+        ()
+
+let handle_error iobuf str =
+  print_endline str
+
+let main () =
+  let host = Unix.gethostbyname "woozle.org" in
+  let dispatcher = Dispatch.create 5 in
+  let conn = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  let _ = Unix.connect conn (Unix.ADDR_INET (host.Unix.h_addr_list.(0), 6667)) in
+  let iobuf = Iobuf.create dispatcher conn "woozle" handle_command handle_error in
+    write iobuf "NICK" ["bot"] None;
+    write iobuf "USER" ["bot"; "bot"; "bot"] (Some "Da Bot");
+    Dispatch.run dispatcher
+    
+
+let _ =
+  main ()

channel.ml

@@ -1,88 +0,0 @@
-module String_map = 
-  Map.Make (struct
-              type t = string
-              let compare = compare
-            end)
-
-type client = Iobuf.t * Irc.nuhost
-
-type t = {name: string;
-          modes: string ref;
-          clients: client String_map.t ref}
-
-let modes = "aimnqpsrtklb"
-
-let by_name = ref String_map.empty
-
-let is_channel_name name =
-  match name.[0] with
-    | '#' | '&' | '!' | '+' ->
-        true
-    | _ ->
-        false
-
-let has_mode chan mode =
-  String.contains !(chan.modes) mode
-
-(* Channels handle:
-   
-  NICK, MODE, JOIN, PART, QUIT, TOPIC, NAMES, LIST, INVITE, KICK, PRIVMSG, NOTICE
-*)
-
-let write iobuf command args text =
-  Iobuf.write iobuf (Command.create (Some !(Irc.name)) command args text)
-
-let broadcast ?(metoo=false) chan sender command args text =
-  let sender_iobuf, sender_nuhost = sender in
-  let cmd = 
-    Command.create
-      (Some (Irc.string_of_nuhost sender_nuhost))
-      command
-      args
-      text
-  in
-  let bwrite _ (iobuf, nuhost) =
-    if (metoo || (nuhost <> sender_nuhost)) then
-      Iobuf.write iobuf cmd
-  in
-    String_map.iter bwrite !(chan.clients)
-
-let reply iobuf nick num ?(args=[]) text =
-  write iobuf num (nick :: args) (Some text)
-
-let handle_action (cli_iobuf, cli_nuhost) chan_name action args text =
-  let chanopt = try
-    Some (String_map.find chan_name !by_name)
-  with Not_found ->
-    None
-  in
-  let nick = Irc.nick cli_nuhost in
-    match (action, chanopt, args, text) with
-      | ("NOTICE", Some chan, [], Some text)
-      | ("PRIVMSG", Some chan, [], Some text) ->
-          if String_map.mem nick !(chan.clients) then
-            broadcast chan (cli_iobuf, cli_nuhost) action [chan_name] (Some text)
-          else
-            reply cli_iobuf nick "404" ~args:[chan_name] "Cannot send to channel (join first)"
-      | ("JOIN", _, _, None) ->
-          let chan =
-            match chanopt with
-              | Some chan -> 
-                  chan
-              | None ->
-                  let c = {name = chan_name; modes = ref ""; clients = ref String_map.empty} in  
-                    by_name := String_map.add chan_name c !by_name;
-                    c
-          in
-            if String_map.mem nick !(chan.clients) then
-              (* Apparently we're expected to drop the command *)
-              ()
-            else
-              let me = (cli_iobuf, cli_nuhost) in
-                chan.clients := String_map.add nick me !(chan.clients);
-                broadcast ~metoo:true chan me "JOIN" [chan.name] None
-      | (_, None, _, _) ->
-          reply cli_iobuf nick "403" ~args:[chan_name] "No such channel"
-      | _ -> 
-          ()
-

channel.mli

@@ -1,10 +0,0 @@
-type t
-
-val modes : string
-
-(** [handle_action (cli_iobuf, cli_nuhost) chan_name action args text]
-    handles [action] on [chan_name] with arguments [args] and text
-    [text], sent by [cli_nuhost] from [cli_iobuf] *)
-val handle_action : (Iobuf.t * Irc.nuhost) -> string -> string -> string list -> string option -> unit
-val is_channel_name : string -> bool
-

client.ml

@@ -1,220 +0,0 @@
-open Irc
-
-(* ==========================================
- * Client stuff
- *)
-type t = {iobuf: Iobuf.t;
-          nick: string ref;
-          away: string option ref;
-          username: string;
-          realname: string}
-
-exception Error of Command.t
-
-let modes = "l"
-
-let dbg msg a = prerr_endline msg; a
-
-let by_nick = Hashtbl.create 25
-
-let lookup nick =
-  Hashtbl.find by_nick nick
-
-let error num args text =
-  Error (Command.create (Some !(Irc.name)) num args (Some text))
-
-let nuhost cli = (!(cli.nick), cli.username, (Iobuf.addr cli.iobuf))
-
-let kill cli message = 
-  Iobuf.close cli.iobuf ("Killed: " ^ message)
-
-let write_command cli cmd =
-  Iobuf.write cli.iobuf cmd
-
-let write cli sender name args text =
-  write_command cli (Command.create sender name args text)
-
-let reply cli num ?(args=[]) text =
-  write cli (Some !(Irc.name)) num (!(cli.nick) :: args) (Some text)
-
-let handle_error cli iobuf message =
-  Hashtbl.remove by_nick !(cli.nick)
-
-let handle_command cli iobuf 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", [], None) ->
-        write cli (Some !(Irc.name)) "ERROR" [] (Some "So long");
-        Iobuf.close iobuf "No reason provided"
-    | (None, "QUIT", [], Some message) ->
-        write cli (Some !(Irc.name)) "ERROR" [] (Some "So long");
-        Iobuf.close iobuf message
-    | (None, "JOIN", ["0"], None) ->
-        ()
-    | (None, "JOIN", [chan_name], None) ->
-        Channel.handle_action (cli.iobuf, (nuhost cli)) chan_name "JOIN" [] 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" as action), [target], Some text)
-    | (None, ("NOTICE" as action), [target], Some text) ->
-        if Channel.is_channel_name target then
-          Channel.handle_action (cli.iobuf, (nuhost cli)) target action [] (Some text)
-        else
-          begin
-            try
-              let peer = lookup target in
-                write peer 
-                  (Some (Irc.string_of_nuhost (nuhost cli))) 
-                  action [target] (Some text)
-            with Not_found ->
-              reply cli "401" ~args:[target] "No such nick/channel"
-          end
-    | (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) ->
-        reply cli "371" (Printf.sprintf "pgircd v%s" Irc.version);
-        reply cli "371" (Printf.sprintf "Running since %f" Irc.start_time);
-        reply cli "374" "End of INFO list"
-    | (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", [], Some text)
-    | (None, "PING", [text], None) ->
-        write cli (Some !(Irc.name)) "PONG" [!(Irc.name)] (Some text)
-    | (None, "PONG", [payload], None) ->
-        (* We do nothing. *)
-        ()
-    | (None, "ERROR", [], Some message) ->
-        write cli (Some !(Irc.name)) "NOTICE" [!(cli.nick)] (Some "Bummer.")
-    | (None, "AWAY", [], None) ->
-        cli.away := None;
-        reply cli "305" "You are no longer marked as being away"
-    | (None, "AWAY", [], Some message) ->
-        cli.away := Some message;
-        reply cli "306" "You have been marked as being away"
-    | (None, "REHASH", [], None) ->
-        ()
-    | (None, "WALLOPS", [], Some text) ->
-        ()
-    | (None, "ISON", nicks, None) ->
-	let ison = List.filter (Hashtbl.mem by_nick) nicks in
-	  reply cli "303" (String.concat " " ison)
-    | (_, name, _, _) ->
-        reply cli "421" ~args:[name] "Unknown or misconstructed command"
-
-let set_nick cli nick =
-  if Hashtbl.mem by_nick nick then
-    raise (error "433" [nick] "Nickname in use");
-  Hashtbl.remove by_nick !(cli.nick);
-  Hashtbl.replace by_nick nick cli;
-  cli.nick := nick
-
-let rec handle_command_prereg (nick, username, realname, password) iobuf cmd =
-  (* Handle a command during the login phase *)
-  let acc =
-    match (Command.as_tuple cmd) with
-      | (None, "PASS", [password'], None) ->
-          (nick, username, realname, Some password')
-      | (None, "USER", [username'; _; _], Some realname') ->
-          (nick, Some username', Some (Irc.truncate realname' 40), password)
-      | (None, "NICK", [nick'], None) ->
-          (Some nick', username, realname, password)
-      | _ ->
-          Iobuf.write iobuf (Command.create
-                               (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);
-      reply cli "003" ("This server was created " ^ 
-                         (string_of_float Irc.start_time));
-      reply cli "004" (!(Irc.name) ^
-                         " " ^ Irc.version ^
-                         " " ^ modes ^
-                         " " ^ Channel.modes);
-      Iobuf.bind iobuf (handle_command cli) (handle_error 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;
-                 away = ref None;
-                 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;
-                 away = ref None;
-                 username = username;
-                 realname = realname}
-    | _ ->
-        Iobuf.bind iobuf (handle_command_prereg acc) (fun _ _ -> ())
-
-let handle_connection d fd addr =
-  let handle_command = handle_command_prereg (None, None, None, None) in
-    Iobuf.create d fd addr handle_command (fun _ _ -> ())
-    

client.mli

@@ -1,6 +0,0 @@
-type t
-
-val write_command : t -> Command.t -> unit
-val write : t -> string option -> string -> string list -> string option -> unit
-val handle_connection : Dispatch.t -> Unix.file_descr -> Unix.sockaddr -> unit
-

command.ml

@@ -1,27 +1,33 @@
-type t = string option * string * string list * string option
+type t = {sender: string option;
+          name: string;
+          args: string list;
+          text: string option}
 
 let create sender name args text =
-  (sender, name, args, text)
+  {sender = sender;
+   name = name;
+   args = args;
+   text = text}
 
 let anon = create None
 
-let as_string (sender, name, args, text) =
+let as_string cmd =
   let ret = Buffer.create 120 in
-    (match sender with
+    (match cmd.sender with
        | None -> 
 	   ()
        | Some s ->
 	   Buffer.add_char ret ':';
 	   Buffer.add_string ret s;
 	   Buffer.add_char ret ' ');
-    Buffer.add_string ret name;
+    Buffer.add_string ret cmd.name;
-    (match args with
+    (match cmd.args with
        | [] ->
 	   ()
        | l ->
 	   Buffer.add_char ret ' ';
 	   Buffer.add_string ret (String.concat " " l));
-    (match text with
+    (match cmd.text with
        | None ->
 	   ()
        | Some txt ->
@@ -64,9 +70,9 @@ let rec from_string line =
     loop None [] line
 
 
-let as_tuple cmd = cmd
+let as_tuple cmd = (cmd.sender, cmd.name, cmd.args, cmd.text)
 
-let sender (sender, name, args, text) = sender
+let sender cmd = cmd.sender
-let name (sender, name, args, text) = name
+let name cmd = cmd.name
-let args (sender, name, args, text) = args
+let args cmd = cmd.args
-let text (sender, name, args, text) = text
+let text cmd = cmd.text

inspect.c

@@ -1,53 +0,0 @@
-#include <stdio.h>
-#include <caml/mlvalues.h>
-
-void
-margin (int n)
-{
-  while (n-- > 0)
-    printf(".");
-  return;
-}
-
-void
-print_block(value v,int m)
-{
-  int size, i;
-  margin(m);
-  if (Is_long(v))
-    { printf("immediate value (%d)\n", Long_val(v));  return; };
-  printf ("memory block: size=%d  -  ", size=Wosize_val(v));
-  switch (Tag_val(v))
-   {
-    case Closure_tag :
-        printf("closure with %d free variables\n", size-1);
-        margin(m+4); printf("code pointer: %p\n",Code_val(v)) ;
-        for (i=1;i<size;i++)  print_block(Field(v,i), m+4);
-        break;
-    case String_tag :
-        printf("string: %s (%s)\n", String_val(v),(char *) v);
-        break;
-    case Double_tag:
-        printf("float: %g\n", Double_val(v));
-        break;
-    case Double_array_tag :
-        printf ("float array: ");
-        for (i=0;i<size/Double_wosize;i++)  printf("  %g", Double_field(v,i));
-        printf("\n");
-        break;
-    case Abstract_tag : printf("abstract type\n"); break;
-    default:
-        if (Tag_val(v)>=No_scan_tag) { printf("unknown tag"); break; };
-        printf("structured block (tag=%d):\n",Tag_val(v));
-        for (i=0;i<size;i++)  print_block(Field(v,i),m+4);
-   }
-  return ;
-}
-
-value
-inspect_block (value v)
-{
-  print_block(v,4);
-  fflush(stdout);
-  return v;
-}

iobuf.ml

@@ -7,7 +7,7 @@ type t = {d: Dispatch.t;
           unsent: string ref;
           ibuf: string;
           ibuf_len: int ref;
-          addr: Unix.sockaddr;
+          name: string;
           handle_command: command_handler ref;
           handle_error: error_handler ref;
           alive: bool ref}
@@ -19,12 +19,7 @@ let ibuf_max = 4096
 let max_outq = 50
 let obuf_max = 4096
 
-let addr iobuf = 
+let name iobuf = iobuf.name
-  match iobuf.addr with
-    | Unix.ADDR_UNIX s ->
-        "UDS"
-    | Unix.ADDR_INET (addr, port) ->
-        Unix.string_of_inet_addr addr
 
 let crlf = Str.regexp "\r?\n"
 
@@ -111,15 +106,16 @@ let bind iobuf handle_command handle_error =
   iobuf.handle_command := handle_command;
   iobuf.handle_error := handle_error
 
-let create d fd addr handle_command handle_error =
+let create d fd name handle_command handle_error =
   let iobuf = {d = d;
                fd = fd;
                outq = Queue.create ();
                unsent = ref "";
                ibuf = String.create ibuf_max;
                ibuf_len = ref 0;
-               addr = addr;
+               name = name;
                handle_command = ref handle_command;
                handle_error = ref handle_error;
                alive = ref true} in
-    Dispatch.add d fd (handle_events iobuf) [Dispatch.Input]
+    Dispatch.add d fd (handle_events iobuf) [Dispatch.Input];
+    iobuf

iobuf.mli

@@ -3,9 +3,9 @@ type t
 type command_handler = t -> Command.t -> unit
 type error_handler = t -> string -> unit
 
-val create : Dispatch.t -> Unix.file_descr -> Unix.sockaddr -> command_handler -> error_handler -> unit
+val create : Dispatch.t -> Unix.file_descr -> string -> command_handler -> error_handler -> t
 val close: t -> string -> unit
 
-val addr : t -> string
+val name : t -> string
 val write : t -> Command.t -> unit
 val bind : t -> command_handler -> error_handler -> unit

irc.mli

@@ -1,4 +1,3 @@
-
 (** (Nickname, username, hostname) tuple *)
 type nuhost = (string * string * string)
 

ircd.ml

@@ -1,40 +0,0 @@
-let dbg msg a =
-  prerr_endline msg;
-  a
-
-(** Establish a server on the given address.
-
-    [connection_handler] will be called with the file descriptor of
-    any new connections.
-*)
-let establish_server d connection_handler addr =
-  let rec handle_event fd events =
-    match events with
-      | [] ->
-	  ()
-      | Dispatch.Input :: tl ->
-	  let cli_fd, cli_addr = Unix.accept fd in
-	    connection_handler cli_fd cli_addr;
-	    handle_event fd tl
-      | Dispatch.Hangup :: tl ->
-	  Dispatch.delete d fd;
-	  handle_event fd tl
-      | _ :: tl ->
-	  handle_event fd tl
-  in
-  let srv = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-    Unix.bind srv addr;
-    Unix.listen srv 50;
-    Unix.setsockopt srv Unix.SO_REUSEADDR true;
-    Dispatch.add d fd handle_event [Dispatch.Input]
-
-let main () =
-  let d = Dispatch.create 50 in
-    establish_server
-      ues
-      (Client.handle_connection d)
-      (Unix.ADDR_INET (Unix.inet_addr_any, 6667));
-    Dispatch.run d
-
-let _ =
-  main ()