/* Log Server - DMS - feb 98 - by Sylvain HUET */

defcom Ccreate=create S S S S;;
defcom Caddlog=addlog S;;
defcom Csetinfo=setinfo S S I I;;
defcom Cservice=service S;;
defcom CdownloadFile=downloadFile S;;

typeof title=S;;

var world="";;
var connex=0;;
var hits=0;;
var maxconnex=0;;
typeof lw=LogWin;;
typeof fifo=[[S r1] [S r1]];;
var ltime=0;;

typeof clis=[[CLIENT I] r1];;

typeof ll=[CLIENT r1];;

typeof logfile=I;;
typeof flog=Logfile;;

fun is(a,b)=a==b;;
fun clibycli(z,a)=let z->[b _] in a==b;;

fun broad(a,c)=_DMSsend this a c;;
fun broadback(s,d)=_DMSsend this d Caddlog [s];;
fun broadsh(a,s)=_DMSservice a s;;

fun addlog(m)=
 apply_on_list ll @broad Caddlog [m];
 if logfile then
   _logsentence flog m 1
 else nil;
 _DMSevent this nil "log" m nil;
 let if time-ltime <60 then ""
 else (set ltime=time;
       ctime time) -> p in
 let strcat p m -> s in
 (_echoLogW lw strcat s "\n";
  set fifo=addFifo s fifo;
  if (sizeFifo fifo)>50 then set fifo=let getFifo fifo ->[_ f] in f
  else nil);;

fun _who(a,b)=
 let ctime time-_channeltime a.chnCLI -> d in
 addlog strcatn a.loginCLI::" ("::(_DMSgetIP a)::") "::
  (substr d 0 (strlen d)-1)::nil;;

fun _comevent(b,s)=
 addlog strcat strcat if b==nil then DMSsender.loginCLI else "Console" " ] " s;
 let hd strextr s -> l in
 let hd l -> c in
 if c==nil then nil
 /*else if !strcmp c "del" then modif seb
  (_DMSdelClient _DMSbyLogin nth_list l 1;
   0)*/
 else if !strcmp c "mem" then
  (addlog strcat "memorysize=" itoa _sizememory;
   addlog strcat "freememory=" itoa _freememory;
   0)
 else if !strcmp c "who" then
  (apply_on_list DMSclients @_who 0;
   0)
 else if !strcmp c "back" then
  if b!=nil then nil else
  (let fifo ->[a _] in apply_on_list a @broadback DMSsender;
   0)
 else if !strcmp c "service" then
  (apply_on_list DMSclients @broadsh
    strcat strcat if b==nil then DMSsender.loginCLI else "Console"
     " > " nth_list l 1;
   0)
 else if !strcmp c "private" then
  (let _DMSbyLogin nth_list l 1 -> d in
   if d==nil then nil
   else _DMSservice d
    strcat strcat if b==nil then DMSsender.loginCLI else "Console"
     " > " nth_list l 2;
   0)
 /*else if !strcmp c "shutdown" then modif seb
  (_closemachine;
   0)*/
 else if !strcmp c "download" then
  if b!=nil then nil else
  (if (_checkpack nth_list l 1)==nil then nil
   else
   (_RSregistersafe this nth_list l 1 1 nth_list l 1;
    _RSallowClient this DMSsender nth_list l 1;
    _DMSsend this DMSsender CdownloadFile [nth_list l 1]);
   0)
 else 0;;

fun __command(s)=
 if (search_in_list ll @is DMSsender)==nil then nil
 else _comevent nil s;;
  
fun _resize(x,s)=
 let x->[win x y w h] in _SIZEwindow lw.winLogW w h x y;
 0;;

fun destroy(s)=_closemachine;;

fun startlog(name)=
 set world=strcat strcat name "." _DMSgetName this;
 if logfile then
   set flog=_openlog strcat "log/" substr world 0 21 255 60
 else nil;
 set lw=
  let _DMSgetZone this "Log" nil @_resize @destroy ->[win x y w h] in
  if win==nil then
   iniLogW _channel DMSwin nil nil 350 250 "LogWindow" nil @_comevent 2
  else
   iniLogW _channel win x y w h "LogWindow" nil @_comevent 1;
 _setLogW lw world connex hits;
 addlog ">>starting";;

fun __register()=
 _DMSsend this DMSsender Csetinfo [_GETtext lw.startLogW world connex hits]
 ;;

fun in(cli)=
 if (!_DMSclientAlive cli)||nil!=search_in_list clis @clibycli cli then nil
 else
 (set connex=connex+1;
  set hits=hits+1;
  _setLogW lw world connex hits;
  apply_on_list ll @broad Csetinfo [_GETtext lw.startLogW world connex hits];
  addlog strcatn "in "::(cli.loginCLI)::" <"::(_DMSgetIP cli)::">"::nil;
  addlog strcatn "hits "::(itoa hits)::nil;
  addlog strcatn "connected "::(itoa connex)::nil;
  if connex<=maxconnex then nil
  else
  (set maxconnex=connex;
   addlog strcatn "max "::(itoa connex)::nil);
  set clis=[cli time]::clis);
 0;;

fun out(cli)=
 let search_in_list clis @clibycli cli -> z in
 if z==nil then nil
 else let z->[_ t0] in
 (set connex=connex-1;
  _setLogW lw world connex hits;
  apply_on_list ll @broad Csetinfo [_GETtext lw.startLogW world connex hits];
  addlog strcatn "out "::(cli.loginCLI)::" <"::(_DMSgetIP cli)::">"::nil;
  addlog strcatn "stayed "::(itoa time-t0)::" sec"::nil;
  addlog strcatn "connected "::(itoa connex)::nil;
  set clis=remove_from_list clis z);
 0;;

fun activate(from,cli,action,param,rep)=
 if !strcmp action "destroy" then
  (set ll=remove_from_list ll cli;
   _DMSdelClientDMI this cli)
 else if !strcmp action "log" then
 (addlog param;
  0)
 else if !strcmp action "register" then
  in cli
 else if !strcmp action "unregister" then
  out cli
 else if !strcmp action "start" then
 (if (!_DMSclientAlive cli)||findList ll cli then nil
  else
  (_DMScreateClientDMI this cli DMSname;
   set ll=cli::remove_from_list ll cli;
   _DMSevent this cli "entering" nil nil);
  0)
 else if !strcmp action "!changeLogin" then
 (addlog strcatn "changeLogin "::param::" -> "::(cli.loginCLI)::" <"::
   (_DMSgetIP cli)::">"::nil;
  0)
 else nil;;

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

fun IniDMI(param)=
 let strextr _getpack _checkpack param -> l in
 set logfile=let getInfo l "logfile" -> lf in
               if (strlen lf) < 0 then 1 else atoi lf;
 _DMSregisterDMI this @activate @out @unregister nil;
 startlog DMSname;;