/* Control Server - DMS - Apr 98 - by Sylvain HUET */
/* rev April 00 - by Sebastien DENEUX */

typeof control=[S r1];;

typeof clis=[CLIENT r1];;
typeof ll=[CLIENT r1];;
typeof localisations = [[CLIENT S] r1];;
typeof nbEventRelay = S;;
typeof ShowIp = I;;

defcom Csetlist=setlist S;;
defcom CaddUser=addUser S;;
defcom CdelUser=delUser I S;;
defcom CupdateUser=updateUser S;;

fun broad(a,c)=_DMSsend this a c;;
fun broadserv(a,s)=_DMSservice a s;;
fun mystrcmp(a,b)= a!=nil && !strcmp a b;;

/*******************************************************************************
  Relay the event
*******************************************************************************/
fun __relay(login,param,i) =
  let _DMSbyLoginI login -> cli in
    _DMSeventTag this CtoU cli strcat "relay." i param nil nil
;;

/*---------*/
fun searchLocalisation(elem, cli)=
 let elem -> [client _] in
 (_DMSgetId client)==_DMSgetId cli;;

/*---------*/
fun createl(l)=
 if l==nil then nil
 else let l->[c n] in
 let search_in_list localisations @searchLocalisation c -> [_ localisation] in
 ((itoa _DMSgetId c)::(if ShowIp then _DMSgetIP c else "XXX")::(itoa time-_channeltime c.chnCLI)::
  (_DMSgetLogin c)::(if localisation == nil then "Connecting..." else localisation)::nil)::createl n;;


/*---------*/
fun createlist()= strbuild createl clis;;

/*---------*/
/*return informations about client c as a string*/
fun createCli(c)=
 let search_in_list localisations @searchLocalisation c -> [_ localisation] in
  strbuild ((itoa _DMSgetId c)::(if ShowIp then _DMSgetIP c else "XXX")::(itoa time-_channeltime c.chnCLI)::(_DMSgetLogin c)::(if localisation==nil then "connecting..." else localisation)::nil)::nil;;

fun _comevent(cli,c,param)=
 if c==nil then nil
 else if !strcmp c "del" then  
  (_DMSdelClient cli;
   0)
 else if !strcmp c "broadcast" then
  (apply_on_list clis @broadserv param;
   0)
 else if !strcmp c "private" then
  (_DMSservice cli param;
   0)
 else if nil!=search_in_list control @mystrcmp c then
  (_DMSevent this cli c param nil;
   0)
 else 0;;

fun __command(id,action,param)=
 let _DMSbyId id -> c in _comevent c action param;;

fun __Register()=
 if findList ll DMSsender then nil
 else
 (set ll=DMSsender::ll;
  _DMSevent this DMSsender "shown" nil nil;
  _DMSsend this DMSsender Csetlist [createlist])
 ;;

fun in(cli)=
 if (!_DMSclientAlive cli)|| findList clis cli then nil
 else
 (set clis=cli::clis;
  set localisations = [cli nil]::localisations;
  apply_on_list ll @broad CaddUser [createCli cli];
  0);;


fun out(cli)=
 if !findList clis cli then nil
 else
 (set clis=remove_from_list clis cli;
  set localisations=removef_from_list localisations @searchLocalisation cli;  
  apply_on_list ll @broad CdelUser [_DMSgetId cli _DMSgetLogin cli];
  0);;


fun activate(from,cli,action,param,rep)=
 if (!strcmp action "entering") && (findList clis cli) then
  (set localisations = [cli _DMSgetName from]::(removef_from_list localisations @searchLocalisation cli);
   apply_on_list ll @broad CupdateUser [createCli cli]) 
 else if !strcmp action "register" then
  in cli
 else if !strcmp action "unregister" then
  out cli
 else if !strcmp action "start" then
  _DMScreateClientDMI this cli linebuild nbEventRelay::(strbuild control::nil)::nil
 else if !strcmp action "destroy" then
 (set ll=remove_from_list ll cli;
  _DMSdelClientDMI this cli)
 else if (!strcmp action "!changeLogin") && (findList clis cli) then
 (apply_on_list ll @broad CupdateUser [createCli cli];  
  0)
 else nil;;

fun unregister(cli)=
 if !findList ll cli then nil
 else
 (set ll=remove_from_list ll cli;
  _DMSevent this cli "hidden" nil nil);
 0;;

fun getQuizz(l)=
 if l==nil then nil
 else let l->[q n] in
 if !strcmp hd q "control" then let hd tl q->c in
  (if c==nil then "" else c)::getQuizz n
 else getQuizz n;;

fun IniDMI(file)=
 let strextr _getpack _checkpack file ->l in 
 (
   set control=getQuizz l;
   set nbEventRelay = getInfo l "nbEventRelay";
   let atoi getInfo l "ShowIp" -> tmp in
     set ShowIp = if tmp == nil then 1 else tmp;

   0
  );
 _DMSregisterDMI this @activate @out @unregister nil;;