From 488fa6a04cab4c8dd1cd35addb277f491d4be02a Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Sun, 8 Feb 2009 20:25:27 -0700 Subject: [PATCH] Convert to be a bot! --- OMakefile | 5 +- bot.ml | 33 ++++++++ channel.ml | 88 --------------------- channel.mli | 10 --- client.ml | 220 ---------------------------------------------------- client.mli | 6 -- command.ml | 30 ++++--- inspect.c | 53 ------------- iobuf.ml | 16 ++-- iobuf.mli | 4 +- irc.mli | 1 - ircd.ml | 40 ---------- 12 files changed, 62 insertions(+), 444 deletions(-) create mode 100644 bot.ml delete mode 100644 channel.ml delete mode 100644 channel.mli delete mode 100644 client.ml delete mode 100644 client.mli delete mode 100644 inspect.c delete mode 100644 ircd.ml diff --git a/OMakefile b/OMakefile index 9306e70..a27780a 100644 --- a/OMakefile +++ b/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[] += diff --git a/bot.ml b/bot.ml new file mode 100644 index 0000000..d26528f --- /dev/null +++ b/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 () diff --git a/channel.ml b/channel.ml deleted file mode 100644 index 461b917..0000000 --- a/channel.ml +++ /dev/null @@ -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" - | _ -> - () - diff --git a/channel.mli b/channel.mli deleted file mode 100644 index aebc329..0000000 --- a/channel.mli +++ /dev/null @@ -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 - diff --git a/client.ml b/client.ml deleted file mode 100644 index 3e88c60..0000000 --- a/client.ml +++ /dev/null @@ -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 _ _ -> ()) - diff --git a/client.mli b/client.mli deleted file mode 100644 index bf10d56..0000000 --- a/client.mli +++ /dev/null @@ -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 - diff --git a/command.ml b/command.ml index d9241b9..1aa287f 100644 --- a/command.ml +++ b/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; - (match args with + Buffer.add_string ret cmd.name; + (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 name (sender, name, args, text) = name -let args (sender, name, args, text) = args -let text (sender, name, args, text) = text +let sender cmd = cmd.sender +let name cmd = cmd.name +let args cmd = cmd.args +let text cmd = cmd.text diff --git a/inspect.c b/inspect.c deleted file mode 100644 index 5d57a9e..0000000 --- a/inspect.c +++ /dev/null @@ -1,53 +0,0 @@ -#include -#include - -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=No_scan_tag) { printf("unknown tag"); break; }; - printf("structured block (tag=%d):\n",Tag_val(v)); - for (i=0;i - "UDS" - | Unix.ADDR_INET (addr, port) -> - Unix.string_of_inet_addr addr +let name iobuf = iobuf.name 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 diff --git a/iobuf.mli b/iobuf.mli index 2d0c370..a6885f4 100644 --- a/iobuf.mli +++ b/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 diff --git a/irc.mli b/irc.mli index d34cf6c..0d313c5 100644 --- a/irc.mli +++ b/irc.mli @@ -1,4 +1,3 @@ - (** (Nickname, username, hostname) tuple *) type nuhost = (string * string * string) diff --git a/ircd.ml b/ircd.ml deleted file mode 100644 index 3ff931d..0000000 --- a/ircd.ml +++ /dev/null @@ -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 ()