/* Ban Server - DMS - Jan. '01 - Mikaël GRIFFOULIERES - François BONELLE */
/* rev January 01 - by Sebastien DENEUX */


defcom Cadd = add I S I;; /* first arg: flag;  snd: IP;  thd: timeOut*/
defcom Cdel = del I S;; /* first arg: flag;  snd: IP*/
defcom CsetBanDefPeriod = setBanDefPeriod I;; /* arg = flag */

typeof oldIPbanned1 = [[S I] r1];;
typeof oldIPbanned2 = [[S I] r1];;
typeof clients = [CLIENT r1];;
typeof banDefPeriod = I;; /* ban period en min */

/* VARIABLES TO BE DELETED WHEN SYSTEM FUNCTIONS WILL BE DEFINED */
typeof IPbanned1 = [[S I] r1];;
typeof IPbanned2 = [[S I] r1];;

var    refreshPeriod=10;; /*refresh period of banned ip list*/


/*-----------*/
/* Recherche un couple [IP timeout]  dans lst, renvoie 1 si trouvé, 2 si IP trouvée seulement, 0 sinon */
fun listFind(elt,lst)=
	if lst==nil then 0
	else
  let listFind elt tl lst -> result in
   if result == 1 then
    1
   else if result == 2 then
    2
   else
    let elt -> [IP TimeOut] in
    let hd lst -> [IPlst TimeOutlst] in
     if (!strcmp IP IPlst) && (TimeOut == TimeOutlst) then
      1
     else if (!strcmp IP IPlst) then
      2
     else
      0
;;

/*-----------*/
/* Renvoie les elts de l1 non présents dans l2 */
fun listCmp (l1, l2)=
	if l1 == nil then nil
	else
	 let listCmp tl l1 l2 -> lst in
	  let hd l1 -> elt in
	   let listFind elt l2 ->result in
	     if (result == 0) || (result == 2)
	       then
	         elt::lst   
	       else
	         lst
;;

/*-----------*/
fun broad (cl, comm)=_DMSsend this cl comm;;

/*-----------*/
/*function called to delete an "elt" in the list corresponding to "flag"*/
fun broadSupp(elt, flag)=
 let elt -> [IP _] in
   apply_on_list clients @broad Cdel [flag IP]
;;

/*-----------*/
/*function called to add an "elt" to the list corresponding to  "flag"*/
fun broadAdd(elt, flag)=
 let elt -> [IP TimeOut] in
  apply_on_list clients @broad Cadd [flag IP (TimeOut)]
;;

/*-----------*/
/* function called to send both lists when a client connects*/
fun broadNew(elt, param)=
 let elt -> [IP timeOut] in
 let param -> [flag cli] in
  _DMSsend this cli Cadd [flag IP (timeOut)]
;;

/*-----------*/
/* Update function, used to refresh both lists of all clients */
fun refreshIP()=
 let _getBannedIPlist 1 -> newList1 in
  (
  let listCmp oldIPbanned1 newList1 -> toDel in
    apply_on_list toDel @broadSupp 1;
  let listCmp newList1 oldIPbanned1 -> toAdd in
    apply_on_list toAdd @broadAdd 1;
    set oldIPbanned1 = newList1;
  );
 let _getBannedIPlist 2 -> newList2 in
	 (
	 let listCmp oldIPbanned2 newList2 -> toDel in
	   apply_on_list toDel @broadSupp 2;
	 let listCmp newList2 oldIPbanned2 -> toAdd in
	   apply_on_list toAdd @broadAdd 2;
	   set oldIPbanned2 = newList2;
	 )
;;

/*-----------*/
/*timer update ip list*/
fun rflRefreshIP(timer,a)=refreshIP;;

/*-----------*/
/* callback function called when a client disconnect */
fun cliDestroyed (cli)=
 set clients = remove_from_list clients cli;
 _DMSeventTag this CtoU cli "destroyed" nil nil nil
;;

/*-----------*/
/*start action, to connect a client*/
fun start(from,user,action,param,others,tag)=
 _DMScreateClientDMI this UtoC user nil
;;

/*-----------*/
/*destroy action, to disconnect a client*/
fun destroy(from,user,action,param,others,tag)=
 _DMSdelClientDMI this UtoC user
;;

/*-----------*/
/*banUser action, to add an IP adress to be banned*/
fun banUser(from,user,action,param,others,tag)=
 let _DMSgetIP UtoC user -> ip in
  _banIP ip banDefPeriod 1;
 refreshIP;
 0
;;

/*-----------*/
/*a client is registering -> send him current banned ip list*/
fun __register()=
 if findList clients DMSsender then
  nil
 else
  (
   set clients=DMSsender::clients;
   apply_on_list (_getBannedIPlist 1) @broadNew [1 DMSsender];
   apply_on_list (_getBannedIPlist 2) @broadNew [2 DMSsender];
   _DMSsend this DMSsender CsetBanDefPeriod [banDefPeriod];
   _DMSeventTag this CtoU DMSsender "in" nil nil nil
  )
;;

/*-----------*/
/*add action called by a client*/
fun __add(flag, IP, timeOut)=
 _banIP IP (timeOut) flag;
 refreshIP
;;

/*-----------*/
/*del action called by a client*/
fun __del(flag, IP)=
 _unbanIP IP flag;
 refreshIP
;;

/*-----------*/
/*action called to modify the default time out*/
fun __modBanDefPeriod (param)=
 set banDefPeriod = param;
 apply_on_list clients @broad CsetBanDefPeriod [banDefPeriod]
;;

/*-----------*/
fun IniDMI (file)=
 let _DMSgetDef this "dmi" -> l in
  set banDefPeriod = (atoi getInfo l "bandef");

 /*refresh ip timer*/
 _rfltimer _starttimer _channel refreshPeriod*1000 @rflRefreshIP nil;
 rflRefreshIP nil nil;

 _DMSregister this nil @cliDestroyed nil;
 _DMSdefineActions this (["banUser" @banUser])::(["destroy" @destroy])::(["start" @start])::nil;
 0
;;