/* <Scol Technologies License> */
/* Copyright (c) 2003, organization : Scol Technologies Association, owner : Sylvain Huet */
/* For conditions of distribution and use, see copyright notice in dms/l/license.txt */
/* or on 'www.scol-technologies.org' */


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;;

var typzip=2;;
var incr=1024;;

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

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

fun continue(p)=
 _logfile "access"::p.ipConn::"[direct]"::nil;
 set SRVpending=remove_from_list SRVpending p.ipConn;
 _deltimer p.timConn;;

fun _SRVconnected(p)=
 set p.ipConn=_channelIP _channel;
 if _isIPbanned p.ipConn 1 then /*test if IP is banned*/
 (_logfile "rejected"::p.ipConn::"[direct]"::nil;
  _closechannel)
 else if (countStrList SRVpending p.ipConn)>SRVsimult then
 (_banIP p.ipConn 1000*SRVblacktime 1; /*add ip to banned ip list*/
  _logfile "blacked"::p.ipConn::"[direct]"::nil;
  _closechannel)
 else
 (set p.timConn=_rfltimer _starttimer _channel SRVtimeout*1000 @_clock p;
  set SRVpending=p.ipConn::SRVpending;
  _logfile "connect"::p.ipConn::"[direct]"::nil;
  _logfile "simult"::(itoa (sizelist DMSclients)+(sizelist SRVpending))::nil;
  set p.lstpConn=packsusers;
  0);;

fun _SRVclosed(p)=
 set SRVpending=remove_from_list SRVpending p.ipConn;
 _logfile "closed"::p.ipConn::"[direct]"::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::"[direct]"::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;
  _setenv _channel _removepkg _envchannel _channel;
  _script scriptserver)
 else
 (set p.indexConn=p.indexConn+incr;
  _on _channel SRaddscript [s]);;

fun _SRVskip(p)=
  continue p;
 _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]);;