struct Conn=[indexConn:I,lstpConn:[[S S S] r1],lastpConn:S,indpConn:I,
flagreqConn:I,timConn:Timer,ipConn:S,stateConn:I] mkConn;;

defcom SRneed = need S I I;;
defcom SRdown = down S;;
defcom SRenddown = enddown;;
defcom SRendoflist = endlist;;
defcom SRpacklst=packlst S;;
defcom SRrequire=require S;;
defcom SRbadversion=badversion;;

defcom SRaddscript = addscript S;;
defcom SRendscript = endscript;;

typeof SRVblack=[[S I] r1];;
typeof SRVpending=[S r1];;
var typzip=2;;
var incr=1024;;
var SRVsimult=10;;
var SRVblacktime=60;;
var SRVtimeout=120;;
var SRVlogfile="logmaster";;
typeof SRVcurrentlogfile=S;;
typeof flog=W;;

/*-----------*/
fun buildtab2(l)=
 if l==nil then "\n"::nil
 else let l->[a next] in
 if next==nil then a::buildtab2 next
 else a::(ctoa 9)::buildtab2 next;;

/*-----------*/ 
fun buildtab(l)=strcatn buildtab2 l;;

/*-----------*/
fun addZero(s)=if (strlen s)==1 then strcat "0" s else s;;

/*-----------*/
/*returns the log file name (in function of the current date)*/
fun getNewLogFile()=
 let localtime time -> [_ _ _ day month year _ _] in
 strcatn "log/"::SRVlogfile::"-"::(itoa year)::"-"::(addZero itoa month)::"-"::(addZero itoa day)::".log"::nil;;

/*-----------*/
/*log a msg*/
fun _logfile(msg)=
 let getNewLogFile -> s in
  if strcmp SRVcurrentlogfile s then
   (
    set SRVcurrentlogfile=s;
    set flog=_getmodifypack SRVcurrentlogfile
   )
 else nil;
 let ctime time -> x in
 let substr x 0 (strlen x)-1 -> date in
  _appendpack buildtab "m"::date::msg flog;;

fun countStrList(l,s)=
 if l==nil then 0 else
 (if !strcmp hd l s then 1 else 0)+countStrList tl l s;;

fun fillpack(l)=
 if l==nil then 0
 else let l->[a n] in let a->[name _ _] in
 let _getpack _checkpack name -> s in
 (mutate a<-[_ if typzip==1 then mzip s else zip s _getlongname s "" "#"];
  fillpack n);;

fun _clock(a,p)=
 _logfile "timeout"::p.ipConn::nil;
 set SRVpending=remove_from_list SRVpending p.ipConn;
 _closechannel;;

fun continue(p,name)=
 _logfile name::p.ipConn::nil;
 set SRVpending=remove_from_list SRVpending p.ipConn;
 _deltimer p.timConn;;

fun purgeblack(l)=
 if l==nil then nil else let l->[a n] in let a->[_ t] in
 if (t-time)>0 then a::purgeblack n else purgeblack n;;
 
fun _SRVconnected(p)=
 set p.ipConn=_channelIP _channel;
 let packsusers->[[_ a _] _] in if (strlen a)==0 then fillpack packsusers else nil;
 if (switchstr (set SRVblack=purgeblack SRVblack) p.ipConn)!=nil then
 (_logfile "rejected"::p.ipConn::nil;
  _closechannel)
 else if (countStrList SRVpending p.ipConn)>SRVsimult then
 (set SRVblack=[p.ipConn time+1000*SRVblacktime]::SRVblack;
  _logfile "blacked"::p.ipConn::nil;
  _closechannel)
 else
 (set p.timConn=_rfltimer _starttimer _channel SRVtimeout*1000 @_clock p;
  set SRVpending=p.ipConn::SRVpending;
  _logfile "connect"::p.ipConn::nil;
  set p.lstpConn=packsusers;
  0);;
  
fun _SRVclosed(p)=
 set SRVpending=remove_from_list SRVpending p.ipConn;
 _logfile "closed"::p.ipConn::nil
;;

fun buildpack(l)=
 if l==nil then nil else let l->[[s cont sign] n] in
 (s::(itoa strlen cont)::"1"::nil)::buildpack n;;

fun _SRVgetpack(p)=
 if p.flagreqConn then nil
 else _on _channel SRpacklst [strbuild buildpack packsusers];;

fun buildreq(l)=
 if l==nil then nil else let l->[[s cont sign] n] in
 (s::(itoa strlen cont)::sign::nil)::buildreq n;;

fun _SRVversion(p,i)=
 set p.flagreqConn=1;
 if i<versionuser then
 (_on _channel SRbadversion [];
  _logfile "badver"::p.ipConn::nil;
  set SRVpending=remove_from_list SRVpending p.ipConn;
  _closechannel)
 else
  _on _channel SRrequire [strbuild buildreq packsusers];;

fun _SRVnextpack(p)=
 if p.lstpConn==nil
 then 
 (_on _channel SRendoflist [];
  set p.lstpConn=packsusers;0)
 else let p.lstpConn -> [a nxt] in let a -> [s cont sign] in
 (set p.lstpConn=nxt;
  set p.lastpConn=cont;
  _on _channel SRneed [s strlen cont typzip]);;

fun _SRVnext(p)=
 let substr scriptuser p.indexConn incr -> s in
 if (strlen s)==0
 then
 (_on _channel SRendscript [];
  continue p "access";
  _setenv _channel _removepkg _envchannel _channel;
  _script scriptserver)
 else
 (set p.indexConn=p.indexConn+incr;
  _on _channel SRaddscript [s]);;

fun _SRVskip(p)=
  continue p "skip";
 _setenv _channel _removepkg _envchannel _channel;
 _script scriptserver;;

fun _SRVdownl(p)=
 if p.stateConn==0
 then
 (set p.stateConn=1;
  set p.indpConn=0)
  else 0;
  let substr p.lastpConn p.indpConn incr -> s
  in if s==nil then nil
  else if (strlen s)==0
  then
  (_on _channel SRenddown [];
   set p.lastpConn=nil;
   set p.stateConn=0)
  else
  (set p.indpConn=p.indpConn+incr;
   _on _channel SRdown [s]);;