diff --git a/Makefile b/Makefile index c88e2f3..2b590d0 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,9 @@ -SOURCES = irccolors.ml vantabot.ml +SOURCES = irccolors.ml store.ml vantabot.ml RESULT = vantabot -PACKS = lwt,irc-client,irc-client-lwt,irc-client-tls +PACKS = lwt,irc-client,irc-client-lwt,irc-client-tls,dokeysto THREADS = yes UNIX = yes -all: native-code +all: byte-code native-code -include OCamlMakefile diff --git a/README.md b/README.md new file mode 100644 index 0000000..4f5e83b --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +a bot for tokin' + +requires the following opam packages: irc-client-tls, irc-client-lwt, dokeysto diff --git a/store.ml b/store.ml new file mode 100644 index 0000000..ccf3cda --- /dev/null +++ b/store.ml @@ -0,0 +1,28 @@ +(** top-level function: `register_nick` *) +module Rwdb = Dokeysto.Db.RW + +let get_db (db : string) : Rwdb.t = + let open Unix in + let already_exists = + try access db [F_OK]; true + with Unix_error(ENOENT,_,_) -> false in + if already_exists + then Rwdb.open_existing db + else Rwdb.create db + +let release_db (h : Rwdb.t) : unit = Rwdb.sync h; Rwdb.close h + +let try_finalize f x finally y = let res = try f x with exn -> finally y; raise exn in finally y; res + +let inc_nick_value (h : Rwdb.t) (nick : string) : unit = + if Rwdb.mem h nick + then let n = int_of_string (Rwdb.find h nick) in + Rwdb.replace h nick (string_of_int (n+1)) + else Rwdb.add h nick "1" + + +let register_nick (db : string) (nick : string) = + let h = get_db db in + try_finalize (inc_nick_value h) nick + release_db h + diff --git a/vantabot.ml b/vantabot.ml index ee7d914..349da3a 100644 --- a/vantabot.ml +++ b/vantabot.ml @@ -1,3 +1,4 @@ +(* for tls support replace [Irc_client_lwt] with [Irc_client_tls] *) open Lwt open Irccolors module C = Irc_client_tls @@ -8,20 +9,24 @@ let formatf = Printf.sprintf (***********************************) (** * Options *) -let host = ref "irc.tilde.chat" +let host = ref "localhost" let port = ref 6697 let realname = ":3" let nick = ref "vantabot" -let channel = ref "#aa00" +let channel = ref "#bots" let username = nick let sleeptime = ref 30. let countdown = ref 5 +let db = 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 nick, " nick prefix (default: " ^ !nick ^ ")" + ; "-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, " database file, will be created if does not exist (default: " ^ !db ^ ")" ] let sendmsg connection m = C.send_privmsg ~connection ~target:!channel ~message:(color_text ~fg:Green ~bg:Black m) @@ -39,9 +44,11 @@ let push_toker t = let tokeplz () = let r = String.concat " " !tokers in - tokers := []; "SMOKE NOW " ^ r +let inc_tokers_count () = + List.iter (Store.register_nick !db) !tokers + let leaf = [ " W "; @@ -66,8 +73,13 @@ let start_toke connection = let rec toker_thread n conn = if n = 0 then begin - sendmsg connection (tokeplz ()) - >>= fun () -> toke_in_progress := false; show_leaf connection + 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)) @@ -153,5 +165,5 @@ let lwt_main () = () let _ = - Arg.parse options (fun _ -> ()) " [options]\nNOTE: SSL only"; + Arg.parse options (fun _ -> ()) " [options]\n"; Lwt_main.run (lwt_main ())