(* for tls support replace [Irc_client_lwt] with [Irc_client_tls] *) open Lwt open Irccolors module C = Irc_client_lwt let logf : string -> unit Lwt.t = Lwt_io.printl let formatf = Printf.sprintf (***********************************) (** * Options *) let host = ref "localhost" let port = ref 6667 let realname = ":3" let botnick = ref "vantabot" let channel = ref "#bots" let username = botnick let sleeptime = ref 30. let countdown = ref 5 let db_file = ref "toke.db" let options = Arg.align [ "-host", Arg.Set_string host, " server host name (default: " ^ !host ^ ")" ; "-port", Arg.Set_int port, " server port (default: " ^ string_of_int !port ^ ")" ; "-chan", Arg.Set_string channel, " target channel (default: " ^ !channel ^ ")" ; "-nick", Arg.Set_string botnick, " nick prefix (default: " ^ !botnick ^ ")" ; "-sleeptime", Arg.Set_float sleeptime, " time period for joining the toke call, in seconds (default: " ^ string_of_float !sleeptime ^ ")" ; "-countdown", Arg.Set_int countdown, " countdown, in seconds (default: " ^ string_of_int !countdown ^ ")" ; "-db", Arg.Set_string db_file, " database file, will be created if does not exist (default: " ^ !db_file ^ ")" ] let sendmsg connection m = C.send_privmsg ~connection ~target:!channel ~message:(color_text ~fg:Green ~bg:Black m) (** * BUSINESS LOGIC HEH *) let toke_in_progress = ref false let tokers = ref [] let push_toker t = let contents = !tokers in let cnd = not (List.mem t contents) in if cnd then tokers := t::contents; cnd let tokeplz () = let r = String.concat " " !tokers in "SMOKE NOW " ^ r let inc_tokers_count () = List.iter (fun n -> Store.register_nick n (Store.DB !db_file)) !tokers let leaf = [ " W "; " WWW "; " WWW "; " WWWWW "; "W WWWWW W"; "WWW WWWWW WWW"; " WWW WWWWW WWW "; " WWW WWW WWW "; " WWW WWW WWW "; " WWWWWWW "; " WWWW | WWWW "; " | "; " | "] let show_leaf connection = leaf |> Lwt_list.iter_s (fun l -> sendmsg connection l) let start_toke connection = toke_in_progress := true; let rec toker_thread n conn = if n = 0 then begin let msg = tokeplz () in inc_tokers_count (); tokers := []; sendmsg connection msg >>= fun () -> toke_in_progress := false; show_leaf connection end else begin sendmsg connection (color_text ~bg:Black ~fg:White (formatf "ready in %i..." n)) >>= fun () -> Lwt_unix.sleep 1. >>= fun () -> toker_thread (n-1) conn end in Lwt.async (fun () -> let slt = !sleeptime in (if slt > 10. then Lwt_unix.sleep (slt-.10.) >>= fun () -> sendmsg connection (color_text ~bg:Black ~fg:LightGreen "toke in ~10s") >>= fun () -> Lwt_unix.sleep 10. else Lwt_unix.sleep slt) >>= fun () -> toker_thread !countdown connection); sendmsg connection (formatf "Toke in progress, type in `!toke' to join. Time to go: ~%.1f secs" !sleeptime) let handle_toke who conn = let is_new = push_toker who in if (!toke_in_progress) then if is_new then sendmsg conn (formatf "%s joins the toke call" who) else return () else start_toke conn let rollcall ?who conn = let pref = match who with None -> "" | Some n -> n ^ ": " in sendmsg conn (pref ^ "vantabot is a bot for synchronized toking. See . TL;DR: the only command is !toke") (***********************************) (** * IRC connection handling code *) let new_channel ~connection ~channel = C.send_join ~connection ~channel >>= fun () -> C.send_privmsg ~connection ~target:channel ~message:(bold_text (color_text ~fg:Green ~bg:Black ".420.")) let nick_of_irc_message imsg = let open Irc_message in match imsg.prefix with | None -> None | Some wh -> match String.split_on_char '!' wh with | a::_ -> Some a | [] -> None let callback connection result = let open Irc_message in match result with | Result.Error e -> logf (formatf "[callback] Error parsing a message: %s" e) | Result.Ok imsg -> logf (to_string imsg) >>= fun () -> (match imsg.command with | PRIVMSG (target, msg) -> if target = !channel && String.length msg > 4 then (* INITIATE OR JOIN THE TOKE *) if String.sub msg 0 5 = "!toke" then match nick_of_irc_message imsg with | None -> return () | Some wh -> handle_toke wh connection (* RESPOND TO ROLLCALL *) else if msg = (!botnick) ^ ": rollcall" then match nick_of_irc_message imsg with | None -> return () | Some wh -> rollcall ~who:wh connection else if msg = "!rollcall" then rollcall connection else return () else return () | _ -> return ()) let lwt_main () = C.set_log logf; C.reconnect_loop ~after:30 ~connect:(fun () -> logf "Connecting..." >>= fun () -> C.connect_by_name ~realname:realname ~username:!username ~server:!host ~port:!port ~nick:!botnick () ) ~f:(fun connection -> logf "Connected" >>= fun () -> new_channel connection !channel) ~callback () let _ = Arg.parse options (fun _ -> ()) " [options]\n"; Lwt_main.run (lwt_main ())