open Irc (* ========================================== * Client stuff *) type t = {iobuf: Iobuf.t; nick: string 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 close cli = Iobuf.close cli.iobuf let write cli cmd = Iobuf.write cli.iobuf cmd let reply cli num ?(args=[]) text = write cli (Command.create (Some !(Irc.name)) num ([!(cli.nick)] @ args) (Some text)) let handle_close cli () = 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", [], 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" 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 (Command.create (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) -> () | (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 (Command.create (Some !(Irc.name)) "PONG" [!(Irc.name)] (Some text)) | (None, "PONG", [payload], 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) -> 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 sometime"; reply cli "004" (!(Irc.name) ^ " " ^ Irc.version ^ " " ^ modes ^ " " ^ Channel.modes); Iobuf.rebind iobuf (handle_command cli) (handle_close 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; 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; username = username; realname = realname} | _ -> Iobuf.rebind iobuf (handle_command_prereg acc) ignore let handle_connection ues grp fd = let command_handler = handle_command_prereg (None, None, None, None) in let close_handler = ignore in Iobuf.bind ues grp fd command_handler close_handler