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

defcom Cregister=register;;
defcom Cadd = add I S I;; /* first arg: flag;  snd: IP;  thd: timeOut*/
defcom Cdel = del I S;; /* first arg: flag;  snd: IP*/
defcom CbanDefPeriod = modBanDefPeriod I;; /* arg: timeout (minute)*/

typeof list1=ObjList;;
typeof list2=ObjList;;
typeof IPedit = ObjText;;
typeof timeOutEdit = ObjText;;
typeof banDefPeriodEdit = ObjText;;

var    pos1 = -1;;
var    pos2 = -1;;

typeof banDefPeriod = I;;
typeof IPbanned1 = [S r1];;
typeof IPbanned2 = [S r1];;


/*-----------*/
fun mystrcmp (a, b)=strcmp a b;;

/*-----------*/
/*Get the element in IPbanned1 or IPbanned2 depending of the flag*/
fun GetElement(flag)=
 if flag==1 then
  nth_list IPbanned1 pos1
 else
  nth_list IPbanned2 pos2
;;

/*-----------*/
/*To create a string from an IP and a time out*/
fun createStrElt(IP, endTime)=
 let IP -> IPresult in
 let ctime endTime -> s in
 (
  let (strlen IP) ->i in while (i<=15) do
   (
    set IPresult = strcat IPresult "  ";
    set i = i + 1
   );  
  strcat IPresult substr s 0 ((strlen s) -1)
 )
;;

/*-----------*/
/* To create a tuple like [flag IP timeOut] from a string */    
fun createEltStr(str,flag)=
 let strextr str -> dblLst in
 let hd dblLst -> [IP [timeOut _]] in
 [flag IP (atoi timeOut)]
;;

/*-----------*/
/* To test if an IP is present in an element*/
fun testIP(elt, param)=
 let param -> [IP flag] in
 let createEltStr elt flag -> [flag IPcur _] in
  !strcmp IPcur IP
;;

/*-----------*/
/* To change dots in spaces*/
fun IPchange(dotPos,IP) =
 if dotPos==nil then nil
 else
  (
   IPchange (tl dotPos) IP;
   set_nth_char IP (hd dotPos) 32;
  )
;;

/*-----------*/
/* To fill a list in the main window*/
fun fill (lb, l)=
 if l==nil
 then
   lb
 else
 (
   _ADDlist lb _GETlistCount lb hd l;
   fill lb tl l
 )
;;

/*-----------*/
/* To verify an IP adress is valid */
fun IPcheck2(lstword,nbElts)=
 let 1 -> checkOK in
 let nil -> IPreturn in
 (
   let 0->i in while i<nbElts do
    (
     let hd lstword -> word in
     let atoi word -> iword in
     (
      if iword == 0 then
       (
        if !strcmp word "*" then
        (
          set IPreturn = strcat IPreturn ".255";
          0
        )
        else if (!strcmp word "0") && (IPreturn != nil) then 
          (
            set IPreturn = strcat IPreturn ".0";
            0
          )
        else set checkOK = 0;
       )
      else
       (
         if (iword > -1) && (iword < 256) then
           (
            if (!strcmp IPreturn nil) then
              set IPreturn = strcat IPreturn itoa iword
            else 
              set IPreturn = strcat strcat IPreturn "." itoa iword;
            0
           )
        else set checkOK = 0;
       );
     );
     set i = i + 1;
     set lstword = tl lstword;
    );
    let (strlen IPreturn)-1 -> size in
     if (nbElts < 4) && (nth_char IPreturn (size)) != 42  && (nth_char IPreturn (size)) != 46 then set IPreturn=strcat IPreturn ".255"
     else IPreturn;
    if (checkOK == 1) then
     (
      let (strlen IPreturn)-1 -> size in
      if (nth_char IPreturn (size)) == 46 then set IPreturn=strcat IPreturn "255"
      else IPreturn;
     )
    else "BadIP"
    )
;;

/*-----------*/      
/* To verify an IP adress is valid */  
fun IPcheck(IP)=
 let strdup IP-> strIP in
 let strlen strIP -> lenstrIP in
 let nil -> dotPos in
 let 0->nbElts in
  (
   let 0->i in while i<lenstrIP do
    (
     let (nth_char strIP i) -> char in
      if char==46 then
      (
       set dotPos = i::dotPos;
       set nbElts = nbElts+1;
       0;
      )
      else 0;
     set i=i+1;
    );
   if dotPos != nil then set nbElts = nbElts + 1
   else nil;
   set strIP=IPchange dotPos strIP;
   let nbElts -> i in while i!=nbElts+1 do
   (
    set strIP=strcat strIP " 255 ";
    set i=i+1;
   );
   if nbElts > 0 && nbElts <5 then
   let strextr strIP -> [listBits _] in
   (
     IPcheck2 listBits 4;
   )
   else "BadIP";
  )
;;

/*-----------*/
/*To send to the server a new element*/
fun rflAdd (b, param)=
 let param -> [flag win] in
  (
  let (IPcheck (_GETtext IPedit)) -> IP in
  let (atoi (_GETtext timeOutEdit)) ->period in
  if (strcmp IP "BadIP") && (period > 0) then
  _DMSsend this Cadd [flag IP period*60]
  else
  (
   _DLGMessageBox _channel nil (_loc this "BAD_IP1" nil) (_loc this "BAD_IP2" nil) 0;
   0
   );
  _DSwindow win; 
  )
;;
  

/*-----------*/
/*To send to the server a new value for the default ban value*/
fun rflButtonValidBanDefPeriod (b,c)=
  set banDefPeriod = (atoi _GETtext banDefPeriodEdit)*60;
 _DMSsend this CbanDefPeriod [banDefPeriod]
;;

/*-----------*/
/* To send to the server an element to remove*/
fun validSuppr(b, param, case)=
(
 if case == 1 then
 let param -> [flag IP] in
 (
   _DMSsend this Cdel [flag IP];
   if flag == 1 then
     set pos1 = -1
   else
     set pos2 = -1
  )
 else 0
);;

/*********************        CALLBACK FUNCTIONS          *********************/

/*-----------*/
fun _end (s)=_DMSdelete this;;

/*-----------*/
fun _destroy(a,b)=_DMSdelete this;;

/*-----------*/
fun _resize(x,s)=0;;

/*-----------*/
fun rflCancel (b, win)=
 _DSwindow win
;;

/*-----------*/
fun click1(l,b,i,s)=
 set pos1=i
;;

/*-----------*/
fun click2(l,b,i,s)=
 set pos2=i
;;

/*-----------*/
fun rflButtonDel (b,c)=
 let (_loc this "DEL1" nil) -> msg in
 if (c==1) && (pos1 != -1) then
 let createEltStr (nth_list IPbanned1 pos1) 1 -> [flag IP timeOut] in 
 ( 
  set msg = strcat strcat strcat msg " " IP (_loc this "DEL2" nil);
  _DLGrflmessage (_DLGMessageBox _channel nil _loc this "BAN" nil msg 1) @validSuppr [flag IP];
  0
 )   
else 
 if (c==2) && (pos2 != -1) then
  let createEltStr (nth_list IPbanned2 pos2) 2 -> [flag IP timeOut] in 
  (
   set msg = strcat strcat strcat msg " " IP (_loc this "DEL2" nil);
   _DLGrflmessage (_DLGMessageBox _channel nil _loc this "BAN" nil msg 1) @validSuppr [flag IP];
   0
  )
 else 0
;;


/*-----------*/
/* Dialog box to add an element (IP + TimeOut) */
fun addBox (b, flag)=
	let _CRwindow _channel DMSwin 100 100 210 100 WN_MENU | WN_MINBOX _loc this "BAN" nil -> subWin in
	 (
	   _CRtext _channel subWin 10 10 90 20 ET_ALIGN_LEFT _loc this "IP_ADRESS" nil;
	   _CRtext _channel subWin 10 40 90 20 ET_ALIGN_LEFT _loc this "PERIOD" nil;
	   set IPedit =  _CReditLine _channel subWin 100 5 100 20  ET_DOWN "";
	   set timeOutEdit = _CReditLine _channel subWin 100 35 100 20  ET_DOWN "";
	  _CBbutton _CRbutton _channel subWin 80 70 60 20 0 (_loc this "VALID" nil) @rflAdd [flag subWin];
	  _CBbutton _CRbutton _channel subWin 145 70 60 20 0 (_loc this "CANCEL" nil) @rflCancel subWin;
	  _SETtext timeOutEdit itoa banDefPeriod/60;
	 )
;;

/***************         ACTIONS CALLED BY THE SERVEUR           ****************/

/*-----------*/
/* The server removes an element from a list*/
fun __del (flag, IP)=
 if flag == 1 then
   let search_in_list IPbanned1 @testIP [IP 1] -> p in
   if p==nil then nil
   else
      let posf_in_list IPbanned1 @testIP [IP 1] -> i in
         (
           set IPbanned1 = remove_nth_from_list IPbanned1 i;
           _DELlist list1 i
         )
   else if flag == 2 then
     let search_in_list IPbanned2 @testIP [IP 2] -> p in
     if p==nil then nil
     else
        let posf_in_list IPbanned2 @testIP [IP 2] -> i in
           (
             set IPbanned2 = remove_nth_from_list IPbanned2 i;
            _DELlist list2 i
           )
   else nil
;;

/*-----------*/
/* The server sets a new value for the default ban value*/
fun __setBanDefPeriod(ban)=
 set banDefPeriod = ban;
 _SETtext banDefPeriodEdit itoa banDefPeriod/60
;;

/*-----------*/
/* The server adds an element to a list*/
fun __add (flag, IP, TimeOut)=
 let [flag IP TimeOut] -> elt in
 let createStrElt IP TimeOut -> s in 
 if flag == 1 then
 (
   set IPbanned1=listcat IPbanned1 s::nil;
   _ADDlist list1 _GETlistCount list1 s;
  set IPbanned1 = rquicksort @mystrcmp IPbanned1;
  fill _RSTlist list1 IPbanned1
 )
 else if flag == 2 then
 (
   set IPbanned2=listcat IPbanned2 s::nil;
   _ADDlist list2 _GETlistCount list2 s;
  set IPbanned2 = rquicksort @mystrcmp IPbanned2;
  fill _RSTlist list2 IPbanned2
 )
 else nil
;;


/********************************   MODULE INITILISATION **********************************/

/*-----------*/
/* To display the main window*/
fun initInterf()=
 let _DMSgetZone this "Ban" @_end @_resize @_end ->[win x y w h] in
 let _CRfont _channel 15 0 FF_WEIGHT "Arial" -> font in  (
   if win==nil
   then 
    (
     set win = _CRwindow _channel nil 100 100 600 400 WN_MENU "Bans";
     _CBwinDestroy win @_destroy nil;
     set x = 0;
     set y = 0;
     set w = 600;
     set h = 400
    )
   else
     nil;    
   let _CRtext _channel win (w/20) 10 (w/3) 25 ET_ALIGN_CENTER _loc this "CURRENT_SITE" DMSname::nil -> title1 in  
     _AFFfontText title1 font;
   let _ENtext _CRtext _channel win (w/20) (h/2-15) (w/3) 25 ET_ALIGN_CENTER _loc this "ALL_SITES" nil 0 -> title2 in
     _AFFfontText title2 font;
   set list1= _CBlistClick _CRlist _channel win (w/20) 25 (3*w/4) (h/3) LB_DOWN|LB_VSCROLL @click1 0;
   set list2= _CBlistClick _CRlist _channel win (w/20) (h/2) (3*w/4) (h/3) LB_DOWN|LB_VSCROLL @click2 0;
   _CBbutton _CRbutton _channel win (w/10+3*w/4) 50 70 35 0 (_loc this "ADD" nil) @addBox 1;    
   _CBbutton _CRbutton _channel win (w/10+3*w/4) 100 70 35 0 (_loc this "DEL" nil) @rflButtonDel 1;
   _ENbutton _CBbutton _CRbutton _channel win (w/10+3*w/4) (h/2+25) 70 35 0 (_loc this "ADD" nil) @addBox 2 0;
   _ENbutton _CBbutton _CRbutton _channel win (w/10+3*w/4) (h/2+75) 70 35 0 (_loc this "DEL" nil) @rflButtonDel 2 0;
   _CRtext _channel win 30 (2*h/3+83) 150 20 ET_ALIGN_LEFT (_loc this "BAN_DEF_PERIOD" nil);  
   set banDefPeriodEdit = _CReditLine _channel win 220 (2*h/3+80) 50 20 ET_DOWN "";  
   _CBbutton _CRbutton _channel win 280 (2*h/3+80) 50 20 0 (_loc this "VALID" nil) @rflButtonValidBanDefPeriod 0;     
  )
;;

/*-----------*/
fun IniDMI(param)=
 _DMSsend this Cregister [];
 initInterf
;;