97 lines
3.0 KiB
OCaml
97 lines
3.0 KiB
OCaml
|
open Irc_client
|
||
|
|
open Lwt
|
||
|
|
|
||
|
|
let formatf = Printf.sprintf
|
||
|
|
|
||
|
|
(** We distinguish between "big channels" (allowed to spam) and "smol channels" (shouldn't spam).
|
||
|
|
Thanks to nilaky for the terminology. *)
|
||
|
|
module Conn (C: CLIENT with type 'a Io.t = 'a Lwt.t) = struct
|
||
|
|
type t = C.connection_t
|
||
|
|
|
||
|
|
let smolchannels = ref []
|
||
|
|
let bigchannels = ref []
|
||
|
|
|
||
|
|
let send_msg (connection : t) ~is_big ?channel (m : string) =
|
||
|
|
let open Lwt_list in
|
||
|
|
let f c =
|
||
|
|
C.send_privmsg ~connection ~target:c ~message:m
|
||
|
|
in
|
||
|
|
let channels = match channel with
|
||
|
|
| None -> if is_big then !bigchannels else !bigchannels @ !smolchannels
|
||
|
|
| Some c -> if is_big && not (List.mem c !bigchannels) then [] else [c]
|
||
|
|
in
|
||
|
|
iter_s f channels
|
||
|
|
|
||
|
|
let insert_channel c is_big =
|
||
|
|
let r = (if is_big then bigchannels else smolchannels) in
|
||
|
|
if List.mem c !r then ()
|
||
|
|
else r := c::!r
|
||
|
|
|
||
|
|
let join_chan (connection : t) ~is_big ~channel =
|
||
|
|
C.send_join ~connection ~channel >>= fun () ->
|
||
|
|
return (insert_channel channel is_big)
|
||
|
|
|
||
|
|
let callbacks = ref []
|
||
|
|
|
||
|
|
let nick_of_irc_message imsg =
|
||
|
|
let open Irc_message in
|
||
|
|
match imsg.prefix with
|
||
|
|
| None -> ""
|
||
|
|
| Some wh ->
|
||
|
|
match String.split_on_char '!' wh with
|
||
|
|
| a::_ -> a
|
||
|
|
| [] -> ""
|
||
|
|
let register_callback ~prefix ~callback =
|
||
|
|
callbacks := (prefix,callback)::!callbacks
|
||
|
|
|
||
|
|
let get_command botnick msg pref =
|
||
|
|
let nl = String.length botnick in
|
||
|
|
let n = String.length pref in
|
||
|
|
let k = nl + 2 + n in
|
||
|
|
if String.get msg 0 = '!' then
|
||
|
|
(* If it's a command starting with "!" *)
|
||
|
|
let msg = String.sub msg 1 (String.length msg - 1) in
|
||
|
|
if String.length msg >= n then
|
||
|
|
Some (String.sub msg n (String.length msg - n))
|
||
|
|
else None
|
||
|
|
else if String.length msg >= k &&
|
||
|
|
String.sub msg 0 k = (botnick ^ ": " ^ pref) then
|
||
|
|
(* If someone is asking the bot directly, e.g.
|
||
|
|
vantabot: rollcall *)
|
||
|
|
Some (String.sub msg k (String.length msg - k))
|
||
|
|
else None
|
||
|
|
|
||
|
|
let callback_loop logf botnick connection result =
|
||
|
|
let open Irc_message in
|
||
|
|
match result with
|
||
|
|
| Result.Error e -> logf (formatf "Error parsing a message: %s" e)
|
||
|
|
| Result.Ok imsg ->
|
||
|
|
match imsg.command with
|
||
|
|
| PRIVMSG (target, msg) ->
|
||
|
|
if (List.mem target !bigchannels || List.mem target !smolchannels)
|
||
|
|
then
|
||
|
|
Lwt_list.iter_s
|
||
|
|
(fun (p,cb) ->
|
||
|
|
match get_command botnick msg p with
|
||
|
|
| None -> return ()
|
||
|
|
| Some rest ->
|
||
|
|
cb connection (nick_of_irc_message imsg) target rest)
|
||
|
|
!callbacks
|
||
|
|
else return ()
|
||
|
|
| _ -> return ()
|
||
|
|
|
||
|
|
|
||
|
|
let pls_connect ~realname ~username ~server ~port ~nick ~logf ~onconnect =
|
||
|
|
C.set_log logf;
|
||
|
|
C.reconnect_loop
|
||
|
|
~after:30
|
||
|
|
~connect:(fun () ->
|
||
|
|
logf "Connecting..." >>= fun () ->
|
||
|
|
C.connect_by_name ~realname ~username ~server ~port ~nick ())
|
||
|
|
~f:(fun connection ->
|
||
|
|
logf "Connected." >>= fun () -> onconnect connection)
|
||
|
|
~callback:(callback_loop logf nick)
|
||
|
|
()
|
||
|
|
|
||
|
|
end
|