158 lines
4.5 KiB
OCaml
158 lines
4.5 KiB
OCaml
open Lwt
|
|
open Irccolors
|
|
module C = Irc_client_tls
|
|
|
|
let logf : string -> unit Lwt.t = Lwt_io.printl
|
|
let formatf = Printf.sprintf
|
|
|
|
(***********************************)
|
|
(** * Options *)
|
|
|
|
let host = ref "irc.tilde.chat"
|
|
let port = ref 6697
|
|
let realname = ":3"
|
|
let nick = ref "vantabot"
|
|
let channel = ref "#aa00"
|
|
let username = nick
|
|
let sleeptime = ref 30.
|
|
let countdown = ref 5
|
|
|
|
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 nick, " nick prefix (default: " ^ !nick ^ ")"
|
|
]
|
|
|
|
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
|
|
tokers := [];
|
|
"SMOKE NOW " ^ r
|
|
|
|
|
|
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
|
|
sendmsg connection (tokeplz ())
|
|
>>= 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
|
|
|
|
(***********************************)
|
|
(** * IRC connection handling code *)
|
|
|
|
(* (\** Join a channel, synchronously *\)
|
|
* let wait_for_join conn chan =
|
|
* let open Irc_message in
|
|
* let m = Lwt_condition.create () in
|
|
* let callback _ = function
|
|
* | Result.Error e -> logf (formatf "[wait_for_join] Error parsing a message: %s" e)
|
|
* | Result.Ok msg ->
|
|
* match msg.command with
|
|
* | JOIN (_,_) -> Lwt_condition.signal m (); return ()
|
|
* | _ -> return ()
|
|
* in
|
|
* Lwt.async (fun () -> C.listen ~connection:conn ~callback ());
|
|
* C.send_join ~connection:conn ~channel:chan
|
|
* >>= fun () -> Lwt_condition.wait m *)
|
|
|
|
|
|
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_prefix s =
|
|
List.hd (String.split_on_char '!' s)
|
|
|
|
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
|
|
if String.sub msg 0 5 = "!toke" then
|
|
match imsg.prefix with
|
|
| None -> return ()
|
|
| Some wh -> handle_toke (nick_of_prefix wh) 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:!nick ()
|
|
)
|
|
~f:(fun connection ->
|
|
logf "Connected"
|
|
>>= fun () -> new_channel connection !channel)
|
|
~callback
|
|
()
|
|
|
|
let _ =
|
|
Arg.parse options (fun _ -> ()) "<vantabot> [options]\nNOTE: SSL only";
|
|
Lwt_main.run (lwt_main ())
|