irc-bot/client.ml

221 lines
7.4 KiB
OCaml

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 uhost 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", [channels], None) ->
let nuhost = (!(cli.nick), cli.username, (Iobuf.addr cli.iobuf)) in
Channel.handle_command cli.iobuf nuhost cmd
| (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 command), [target], Some text)
| (None, ("NOTICE" as command), [target], Some text) ->
if Channel.is_channel_name target then
reply cli "403" ~args:[target] "No such channel"
else
begin
try
let peer = lookup target in
write peer (Some (uhost cli)) command [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 _ _ -> ())