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

/* sDHDMS - mar 00 - by Sylvain HUET */
/* core part */

/* global constants */
var fixdirectory=0;; /* fixdirectory = 1 : only modules in dms/ subdirectory are accepted */
var hidden_server=0;; /* 1 : do not display message boxes */

/* global datas */
typeof DMSwin=ObjWin;;
typeof DMSenv=Env;;
typeof DMSserver=Chn;;

typeof DMSdmi=tab DMI;;
typeof DMSnbDmi=I;;

typeof DMSname=S;;
typeof DMStimeout=I;;

typeof DMSclients=[CLIENT r1];;
typeof DMSport=I;;
typeof DMShttpport=I;;
typeof DMSfileCli=S;;

typeof DMSsender=CLIENT;;

typeof DMSpathname=S;; /* path/name (without suffix) */
typeof DMSpath=S;; /* path */


typeof BARfore=I;;
typeof BARback=I;;
typeof BARtext=I;;

/* server number */
var MASTERNUMBER=0;; /* master server number */
var serverNumber=0;; /* number of current server */

fun _defServerNumber(n)=set serverNumber=n;;
fun _getServerNumber()=serverNumber;;

fun conc(p,q)=if p==nil then q else (hd p)::conc tl p q;;


/* get values of a given field */
fun getInfo(l,s)=hd switchstr l s;;
fun getInfos(l,s)=switchstr l s;;
fun getConcInfos(l,s)=
 if l==nil then nil else let l->[[a b] nxt] in
 if !strcmp a s then conc b getConcInfos nxt s
 else getConcInfos nxt s;;

fun getTabInfos(l,s)=
 if l==nil then nil else let l->[[a b] nxt] in
 if !strcmp a s then b::getTabInfos nxt s
 else getTabInfos nxt s;;

fun swbystr(a,b)=let a->[x _] in !strcmp x b;;
fun getSwitchStr(l,s)=search_in_list l @swbystr s;;

fun swbyequ(a,b)=let a->[x _] in x==b;;
fun getSwitch(l,x)=search_in_list l @swbyequ x;;

/* return wether an element is in a list */
fun findList(l,a)=
 if l==nil then 0 else let l->[x n] in
 if a==x then 1 else findList n a;;

/* return wether a string element is in a list */
fun strFindList(l,a)=
 if l==nil then 0 else let l->[x n] in
 if !strcmp a x then 1 else strFindList n a;;

fun Tunder(s)=if strcmp s "_" then s else nil;;
fun Tnil(s)=if s==nil then "_" else s;;

/* return path of a filename */
fun lastslash(s,i)=
 let strfind "/" s i ->j in
 if j==nil then i
 else lastslash s j+1;;

fun _DMSgetpath(path)=substr path 0 lastslash path 0;;

/* manage relativ paths (relativ files should start with ./) */
fun _DMSrelativpath(path,l)=
 if l==nil then nil
 else let l->[n nxt] in
 (if !strcmp substr n 0 2 "./" then strcat path substr n 2 strlen n
  else n)::_DMSrelativpath path nxt;;


/* communication constructors */
defcom Cloclink=loclink I S I S S S;; /* client2client link */
defcom Chookevent=hookevent I S;; /* client events to be hooked by server */
defcom Cendgraph=endgraph I;; /* message indicating that all c2c links and hooks have been sent */
/* modif 01 02 */
defcom Cinit=init I I S I I I S I I I S I;; /* starting client : xhttp nbdmi name timeout time tickcount preDmi barback barfore bartext download_name download_port*/
defcom Clogon=logon S I S;; /* logon client : login id sccfile */
defcom Cping=ping;; /* ping message */
defcom Cpublic=public S I;; /* message to scol engine */
defcom CpublicHTTP=publicHTTP S I;; /* message to scol engine */
defcom CbadVersion=badVersion S S S;; /* bad version message : title, msg, url */
defcom Ccreate=create I S I S S S S;; /* create a client module : father,name,id,class,param,zones,lang file */
defcom Caddlf=addlf I S;; /* add a list of (files,sign) */
defcom Caddlfneeded=addlfneeded I S;; /* add a list of needed files */
defcom Ccatlf=catlf I S S S;; /* add a new (file,sign) */
defcom Cdelete=delete I;; /* destroy a client module */
defcom Csend=send I S;; /* send a message to a client */
defcom Cservice=service S;; /* send a service message */
defcom Caction=action I I S S S S I;; /* send action to a client module : mod user act param rep ulist tag */
defcom CcreateUI=createUI I I I S S S;; /* create a user instance */
defcom CchgClassUI=chgClassUI I I S S;; /* change class of userinstance */
defcom CsetParamsUI=setParamsUI I I S;; /* change all params of userinstance */
defcom CsetParamUI=setParamUI I I S S;; /* change one param of userinstance */
defcom CdeleteUI=deleteUI I I;; /* delete a userinstance */
defcom CsendUI=sendUI I I S S;; /* send message to a userinstance : mod, ui, action, param */
defcom Cdeltag=deltag I;; /* a tag should be destroyed : id */
defcom Cfiretag=firetag I S S;; /* a tag should be fired : id, param, ulist */
defcom ChookInactive=hookInactive S;; /* list of hooks for inactive clients */
defcom CpurgeHook=purgeHook I I;; /* ordre hook purge : mod, hook number */
defcom CreinitLoc=reinitLoc I;; /* order reinitialization of loc files */

/* script constructors */
defcom SIniDMI=IniDMI S;;
defcom Sreg=reg I;;
defcom Sload=_load S;;

/* proto */
proto _DMIstartModule=fun[GRAPH] GRAPH;;
proto UcreateUser=fun[CLIENT] User;;
proto _on_=fun[CLIENT Comm] I;;
proto _DMSgetByHandle=fun[I] DMI;;
proto _DMSgetHandle=fun[DMI] I;;
proto _DMSgetDef=fun[DMI S] [[S r1] r1];;
proto _DMSupdateDef=fun[DMI S [[S r1] r1]] I;;
proto _DMSbyx=fun[I] CLIENT;;
proto _DMSgetZones=fun[DMI] [[S r1]r1];;
proto _DMSgetZone=fun[DMI S fun [S] I fun[[ObjWin I I I I] S] I fun [S] I] [ObjWin I I I I];;
proto UaddItem=fun[User Item] I;;
proto UsubItem=fun[User S I] I;;
proto UfindItem=fun[User S] Item;;
proto UclearItem=fun[User] I;;
proto UdelClient=fun[DMI CLIENT] I;;
proto UgetUserIid=fun[DMI I] UserI;;
proto UgetGlobalUser=fun[I] User;;
proto UdelGlobalUser=fun[User] I;;
proto DMIcheckpack=fun [DMI S] P;;
proto _DMSrootModule=fun[] DMI;;
proto _DMSdelete=fun[DMI] I;;

/* closing server */

fun _dmscloseserver()=
 _fooS "####_dmscloseserver";
 _DMSdelete _DMSrootModule;
 _closemachine;;

/* error & warning manager */

typeof errorsbook=[S r1];;
var noerror=1;;

/* add an error in the book */
fun _adderror(s)=set errorsbook=s::"\n"::errorsbook; set noerror=0; s;;
/* add a warning in the book */
fun _addwarning(s)=set errorsbook=s::"\n"::errorsbook; s;;

fun _closeinit(a,b)=_dmscloseserver;;
fun _resizeWI(a,t,x,y)=_SIZEtext t x-2 y-2 1 1;;
fun _cannotstart(s)=
 _fooS s;
 let _CRwindow DMSserver DMSwin 150 150 500 300 WN_MENU+WN_MINBOX+WN_SIZEBOX "Cannot Start Server" 
 -> win in
 (_CBwinDestroy win @_closeinit nil;
  _CBwinSize win @_resizeWI (_CRtext DMSserver win 1 1 498 298 ET_VSCROLL+ET_HSCROLL s));
 0;;

fun _logBook()=
 strcatn errorsbook;;

/* stop server if error (return 1 if stop, 0 if continue)*/
fun _stopiferror()=
 let strcatn errorsbook -> book in
 if noerror then 0
 else
 (_cannotstart book;
  if hidden_server then _dmscloseserver
  else nil;
  1);;
 
 

/* http functions */
var h8="00000000";;
var h4="0000";;

fun itoh8(i)= let itoh i -> s in strcat substr h8 0 8-strlen s s;;
fun itoh4(i)= let itoh i -> s in strcat substr h4 0 4-strlen s s;;

var http_header="HTTP/1.0 200 OK\13\10Server: SCOL HTTP server\13\10Content-Type: application/x-unknown\13\10\13\10";;

/* time functions */
fun _DMStime()=time;;
fun _DMStickcount()=_tickcount;;

/* end function */
fun _endE(a,b,r)=_dmscloseserver;;


/* broadcast function */
fun broad(c,msg)=_on_ c msg;;

/* service function */
fun _DMSservice(cli,s)=_on_ cli Cservice [s];;

/* NewTimer */
struct NewTimer=[tTimer:Timer]mkMyTimer;;
fun New_starttimer(chn,per)= mkMyTimer[_starttimer chn per];;
fun New_rfltimer(t,f,x)= _rfltimer t.tTimer f x;;
fun New_deltimer(t)= _deltimer t.tTimer;;

/* structures */
struct Item=
 [refItem:S,nameItem:S,countItem:I,dateItem:I
 ]mkItem;;

struct User=
 [idU:I,cliU:CLIENT,flagU:I,itemU:[Item r1]]mkUser;;

struct CLIENT=
 [userCLI:User,chnCLI:Chn,ipCLI:S,loginCLI:S,rsCLI:[[S S]r1],
  allowedResCLI:[RSdef r1],activCLI:[DMI r1],
  timeoutCLI:I,activeXCLI:I,versionCLI:I,langCLI:S,
  xCLI:I,conCLI:HTTPcon,httpnumCLI:I,httpCLI:I,
  httppendCLI:S,trCLI:S,idCLI:I,
  tagsCLI:[TagToClient r1]
 ]mkCLI;;

var SIZE_GRID_MODULO=1024;;

struct Tree =[labelTree:S,groupTree:tab [UserI r1],listTree:[UserI r1],fatherTree:Tree,sonsTree:[Tree r1]]mkTree;;

struct DMI=
 [graphDMI:GRAPH,numDMI:I,classDMI:S,stateDMI:I,chnDMI:Chn,
  resDMI:[RSdef r1],controlDMI:[[S r1]r1],
  deleteDMI:fun [CLIENT] I,beforecloseDMI: fun[] I,logoutDMI:fun [CLIENT] I,
  actionDMI:fun [DMI CLIENT S S S] I, actionsDMI:[[S fun [DMI User S S [User r1] Tag] I] r1],
  hookactionsDMI:[[S fun [CLIENT S] I] r1],cbuploadDMI:fun[CLIENT S S] I,

  cliDMI:[CLIENT r1],
  ulistDMI:[UserI r1],
  utreeDMI:Tree,
  locDMI:tab [[S S] r1], pathlocDMI:S, loclistDMI:[[S tab[[S S] r1] S S] r1],
  extralangDMI:[S r1],
  fileDMI:S,clientneededDMI:S,thmDMI:S,thmsDMI:[[S r1]r1]
 ]mkDMI;;


struct VTree=[commutVT:I,rightsVT:[S r1],treeVT:Tree,xVT:I,yVT:I,zVT:I,itabVT:I] mkVTree;;

struct UserI=
 [userUI:User,classUI:S,paramUI:[[S r1]r1],
  locUI:DMI,visiUI:VTree,cbDelCliUI:fun[UserI CLIENT] I,cbDeleteUI:fun[UserI] I,
  cbCommUI:fun[UserI CLIENT S S] I, msgUI:[[S fun[UserI CLIENT S S] I] r1],commutUI:I,rightsUI:[S r1]
 ]mkUserI;;
 
/* tmp */