/* <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' */

/* sconnects.pkg - january 2001 - by Sebastien DENEUX */

/*connection log, black list*/


typeof SRVblack=[[[I I I I] I] r1];; /*[[xxx.xxx.xxx.xxx] endTime]*/
typeof SRVpending=[S r1];;
var    SRVsimult=10;;
var    SRVblacktime=60;;
var    SRVtimeout=120;;
var    SRVlogfile="logfile";;
typeof SRVcurrentlogfile=S;;
typeof flog=W;;


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

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

/*-----------*/
/*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 DMSname::date::msg flog;;

/*-----------*/
fun cutIP(ip)= 
 let strfind "." ip 0 -> pos1 in
 let strfind "." ip pos1+1 -> pos2 in
 let strfind "." ip pos2+1 -> pos3 in
 let substr ip 0 pos1 -> ip1 in
 let substr ip pos1+1 pos2-pos1-1 -> ip2 in
 let substr ip pos2+1 pos3-pos2-1 -> ip3 in
 let substr ip pos3+1 3 -> ip4 in 
  [atoi ip1 atoi ip2 atoi ip3 atoi ip4];;

/*-----------*/
fun makeIPlist(l)=
 if l==nil then nil
 else
  let l -> [[[ip1 ip2 ip3 ip4] endTime] q] in     
   ([strcatn (itoa ip1)::"."::(itoa ip2)::"."::(itoa ip3)::"."::(itoa ip4)::nil endTime])::(makeIPlist q);;

/*-----------*/
fun _ipByVal(a,b)=
 let a -> [[ip1_1 ip1_2 ip1_3 ip1_4]_] in
 let cutIP b -> [ip2_1 ip2_2 ip2_3 ip2_4] in
  ip1_1==ip2_1 && ip1_2==ip2_2 && ip1_3==ip2_3 && ip1_4==ip2_4;;

/*-----------*/
fun testIPbanned(l,ip)=
 if l==nil then
  0
 else
  let l -> [[[ip2_1 ip2_2 ip2_3 ip2_4] _] q] in
  let ip -> [ip1_1 ip1_2 ip1_3 ip1_4] in
   if ip2_1==255 then 1
   else if ip1_1==ip2_1 then
    if ip2_2==255 then 1
    else if ip1_2==ip2_2 then
     if ip2_3==255 then 1
     else if ip1_3==ip2_3 then
      if ip2_4==255 then 1
      else if ip1_4==ip2_4 then 1
      else
       testIPbanned q ip
     else
      testIPbanned q ip
    else
     testIPbanned q ip
   else
    testIPbanned q ip;;

/*-----------*/
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 _purgeBlack(t,b)=set SRVblack=purgeblack SRVblack;;

/*-----------*/
/*initialize blackList purge timer (every 10 minutes)*/
fun _BLACKLISTpurgeInit()=_rfltimer _starttimer DMSserver 600000 @_purgeBlack nil;;

/*-----------*/
/*returns 1 if IP is banned, else 0*/
fun _isIPbanned (ip,flag)=
 set SRVblack=purgeblack SRVblack;
 if flag&1 then
  testIPbanned SRVblack cutIP ip
 else nil;;

/*-----------*/
/*add a user to the banned ip list*/
/*returns 1 if successfull, 0 if IP already in list, nil if ip syntax error*/
/*IP must be in format A.B.C.D*/
fun _banIP(ip,period,flag)=
 if flag&1 then
  if (search_in_list SRVblack @_ipByVal ip)==nil then
   let cutIP ip -> ip2 in
    if ip2==nil then nil
    else
     (set SRVblack=[ip2 time+period]::SRVblack;1)
  else 0
 else nil;;

/*-----------*/
/*remove a user from the banned ip list*/
/*returns 1 if successfull, 0 if IP not in list*/
fun _unbanIP(ip,flag)=
 if flag&1 then
  let search_in_list SRVblack @_ipByVal ip -> e in
   if e==nil then
    0
   else
    (set SRVblack=remove_from_list SRVblack e;1)
 else nil;;

/*-----------*/
/*returns the banned list [[[xxx.xxx.xxx.xxx] endTime] r1]*/
fun _getBannedIPlist(flag)=
 if flag&1 then
  makeIPlist SRVblack
 else nil;;