Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: 3.0-alpha
Fetching contributors…

Cannot retrieve contributors at this time

file 60 lines (54 sloc) 2.059 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
(*
* (c) 2004-2012 Anastasia Gornostaeva
*)

open StanzaError
open JID
open Hooks
open Muc
open XMPPClient

module MUC = XEP_muc.Make(XMPPClient)
open MUC

let r = Random.self_init ()

let roulette muc_context xmpp env kind jid_from text =
  if text <> "" then
    env.env_message xmpp kind jid_from
      (Lang.get_msg env.env_lang "plugin_roulette_syntax_error" [])
  else
    let room_env = get_room_env muc_context jid_from in
    let myitem = Occupant.find room_env.mynick room_env.occupants in
      if myitem.role = RoleModerator then
        let item = Occupant.find jid_from.lresource room_env.occupants in
          if item.role = RoleModerator then
            env.env_message xmpp kind jid_from
              (Lang.get_msg env.env_lang "plugin_roulette_not_allowed" [])
          else if Random.int 10 = 1 then
            let callback ev _jidfrom _jidto _lang () =
              match ev with
                | IQResult el ->
                    env.env_message xmpp kind jid_from
                      (Lang.get_msg env.env_lang "plugin_roulette_bye" [])
                | IQError err ->
                    env.env_message xmpp kind jid_from
                      (if err.err_text = "" then
                         Lang.get_msg env.env_lang
                           "plugin_roulette_kick_failed" []
                       else err.err_text)
            in
            let reason =
              Lang.get_msg env.env_lang "plugin_roulette_kick_reason" [] in
              Muc.kick xmpp ~reason jid_from jid_from.lresource
                callback
          else
            env.env_message xmpp kind jid_from
              (Lang.get_msg env.env_lang "plugin_roulette_next_time" [])
      else
        env.env_message xmpp kind jid_from
          (Lang.get_msg env.env_lang "plugin_roulette_not_allowed" [])
          
let plugin opts =
  Muc.add_for_muc_context
    (fun muc_context xmpp ->
       Plugin_command.add_commands xmpp
         [("roulette", roulette muc_context)] opts
    )

let () =
  Plugin.add_plugin "roulette" plugin
Something went wrong with that request. Please try again.