neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Convert to be a bot!

This commit is contained in:
Neale Pickett 2009-02-08 20:25:27 -07:00
parent cf9bdcb93a
commit 488fa6a04c
12 changed files with 62 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
OMakefile
View File

@ -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[] +=

33
bot.ml Normal file
View File

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

88
channel.ml
View File

@ -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"
| _ ->
()

10
channel.mli
View File

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

220
client.ml
View File

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

6
client.mli
View File

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

30
command.ml
View File

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

53
inspect.c
View File

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

16
iobuf.ml
View File

@ -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 =
match iobuf.addr with
| Unix.ADDR_UNIX s ->
"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

4
iobuf.mli
View File

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

1
irc.mli
View File

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

40
ircd.ml
View File

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