/* Scol Engine 5 - 2008/04/22 - B.Bourineau */

fun pubbyname(a,s)=
  let a->[x _ _] in !strcmp webtostr x webtostr s;;


fun nameofpub(a)=
  let a->[x _ _] in x;;


fun ipofpub(a)=
  let a->[_ port port2] in
  if port==nil then
    if port2==nil then nil else
      strcatn "scol://applet:http://"::_hostIP::":"::(itoa port2)::"/"::(itoh4 port2)::"?X"::nil
  else
    strcatn "scol://"::_hostIP::":"::(itoa port)::nil;;
    
    
fun ipofpub2(a)=
  let a->[_ port port2] in
  if port==nil && port2==nil then nil else
    strcatn "scol://"::_hostIP::":"::(nameofpub a)::nil;;


fun searchpub(l,n)= 
  if l==nil then nil else
    let l->[r nxt] in
    let search_in_list r.pubRun @pubbyname n -> x in
    (
      if x==nil then
        searchpub nxt n
      else
        x
    );;


fun searchpub2(l,n)=
  if l==nil then nil else
    let l->[r nxt] in
    let search_in_list r.pubRun @pubbyname n -> x in
    (
      if x==nil then
        searchpub2 nxt n
      else
        r
    );;


fun _resizeT(a,t,x,y)=
  _SIZEtext t x-2 y-2 1 1;;


fun chgusm2(l,a,b,s,k)=
  if l==nil then
    if k then
      s::nil
    else nil
  else
    let l->[ll n] in
    let hd strextr ll -> [h [hh _]] in
    if (!strcmp h a)&&((b==nil)||(!strcmpi b substr hh 0 strlen b)) then
      s::chgusm2 n a b s 0
    else
      ll::chgusm2 n a b s k;;


fun chgusm(a,b,line)=
  _saveusmini linebuild chgusm2 (lineextr _loadusmini nil) a b line 1;;


fun buildl(l)=
  if l==nil then nil else
    let l->[a n] in let buildl n -> res in
    if (!strcmp substr a 0 19 "locked/lang/master.")&&(!strcmp substr a (strlen a)-5 5 ".lang") then
      let hd getInfos strextr _getpack _checkpack a "LANGUAGE" -> s in
      if s==nil then
        res
      else
        [substr a 19 (strlen a)-24 s]::res
    else res;;


fun insertstring(s,l,f)=
  if l==nil then
    s::nil
  else
    let exec f with [s hd l] -> res in
    if res==0 then
      insertstring s tl l f
    else if res<0 then
      s::l
    else
      (hd l)::insertstring s tl l f;;


fun sort(l,f)=
  if l==nil then nil else
    insertstring hd l sort tl l f f;;


fun cmpbyclear(x,y)=
  let x->[_ a] in
  let y->[_ b] in
    strcmp a b;;


fun buildlanguages()=
  set languages = sort buildl _listoffiles "locked/lang" @cmpbyclear;;


fun reinitloc()=
  buildlanguages;
  /*patch au cas ou la langue choisie est chinese (date de l'erreur : 10/2000)( master.chinese.lang anciennement présent et remplacé par master.chineseS.lang)*/
  if !strcmpi _getress "DefaultLanguage" "chinese" then
  (
    chgress  "DefaultLanguage" "english";
    _setress "DefaultLanguage" "english"
  )
  else nil;
  
  startloc "locked/lang/master";
  0;;


fun launchmachine(n,r)=
  _newmachine n _getpack _checkpack n r 0;
  0;;


fun launchscript(n)=
  launchmachine n.nameScript n.rightsScript;;


fun _launch(t,n)=
  launchscript n;;


fun search_in_script(l,f,i)=
  if l==nil then nil else
    let l->[a n] in
    if exec f with [a i] then
      a
    else
      let search_in_script a.sonsScript f i -> b in
      if b!=nil then
        b
      else
        search_in_script n f i;;


fun srvbyname(r,s)=
  if !strcmp r.nameScript s then
    1
  else
    0;;


fun srvbyclear(r,s)=
  if !strcmp r.clearScript s then
    1
  else
    0;;


fun runbychan(r,c)=
  if r.canalRun==c then
    1
  else
    0;;


fun runbyname(r,n)=
  if !strcmp r.nameRun n then
    1
  else if !strcmp r.nameRun strcat n " *" then
    1
  else
    0;;


fun rebuild2(l)=
  if l==nil then nil else
    let l->[a b] in
    if b==nil then
      a::nil
    else
      a::" "::rebuild2 b;;


fun rebuild(l)=
  if l==nil then nil else
    let l->[a nxt] in
    if (nth_char hd a 0)=='> then
      let rebuild nxt -> [nxt2 q] in
      let mkScript[nil strcatn rebuild2 a nil nil q]-> s in
      let rebuild nxt2->[nxt3 qq] in [nxt3 s::qq]
    else if !strcmp hd a "<" then
      [nxt nil]
    else
      let rebuild nxt->[n q] in
        [n (mkScript[hd tl a hd a nil nil nil])::q];;


fun servics()=
  let search_in_list customs @srvbyclear loc "STARTUP"->s in
    s.sonsScript;;


fun launch(t,l)=
  if l==nil then
    _deltimer t
  else
    let l->[x n] in
    (
      launch nil x.sonsScript;
      if x.nameScript!=nil then
        launchscript x
      else nil;
      
      if t==nil then
        set t=_starttimer _channel AutoStartDelay
      else nil;
      
      _rfltimer t @launch n;
      nil
    );;


fun newstart(l,olds)=
  if l==nil then
    0
  else
    let l->[x n] in
    (
      newstart x.sonsScript olds;
      let search_in_script olds @srvbyname x.nameScript -> s in
      if s==nil then
        launchscript x
      else nil;
      newstart n olds
    );;


fun initcustserv()=
  let rebuild strextr _getpack _checkpack "locked/etc/custom.txt" ->[_ c] in
    set customs=c;
  0;;


fun _select(t,r)=
  set current=r;
  _scriptc r.canalRun "_load \"locked/master2.pkg\"\niniwindow";
  0;;


/*public*/
fun createpublic2(r,mpublic)=
  let ipofpub r -> url in
    _CBmenu (_APPitem chn0 mpublic ME_ENABLED strcat strcat nameofpub r " : " url) @_contact ipofpub r;;


fun createpublic(r,mpublic)=
  apply_on_list r.pubRun @createpublic2 mpublic;;


fun refreshpublic(m)=
  apply_on_list running @createpublic m;;


/*----------*/
fun contact(s,env)=
  if (!strcmp substr s 0 8 "https://")||(!strcmp substr s 0 7 "http://")||(!strcmp substr s 0 7 "file://")||(!strcmp substr s 0 6 "ftp://")||(!strcmp substr s 0 6 "rtsp://")||(!strcmp substr s 0 7 "mailto:") then
  (
    _openbrowserhttp s;
    set numb=numb+1;
    0;
  )
  else
  (
    _newmachine strcat "browser" itoa numb (strcat "_load \"locked/stduser.pkg\"\n" mkscript maincom [s rights env]) nil 0;
    set numb=numb+1;
    0;
  );
  0;;


/*ressources*/
fun _destroyress(s)=
  if s==nil then nil else
    _saveressini s;
  0;;


fun _editress(a,b)=
  iniText chn0 nil 300 300 loc "RSE" loc "RSE" @_destroyress _loadressini;
  0;;


/*expert mode*/
fun _destroypart(s)=
  if s==nil then nil else
    _saveusmini s;
  0;;


fun _editpart(a,b)=
  iniText chn0 nil 300 300 loc "CFE" loc "CFE" @_destroypart _loadusmini nil;
  0;;


/*contact*/
fun _contact(t,n)=
  contact n nil;;


fun _gotosite(a,b)=
  _contact nil b; 
  0;;


fun _startscript(x,s)=
  launchmachine s nil;;


fun processpile(flags,l)=
  if l==nil then
    0
  else
    let l->[[com [arg1 [arg2 _]]] n] in
    (
      if !strcmp com "goto" then
      (
        contact arg1 nil;
        processpile flags n;
      )
      else if !strcmp com "loadupdpkg" then
      (
        _storepack arg2 arg1;
        processpile flags n;
      )
      else if !strcmp com "startupd" then
      (
        _openchannel nil strcatn (substr arg1 0 (strlen arg1)-1)::"\ "::(itoa flags)::"\n"::nil _envchannel _channel;
        processpile flags n;
      )
      else processpile flags n;
    );;


fun fullurl(srv,port,req,first)=
  strcatn "http://"::srv::":"::(itoa if first then port else portdef)::"/"::(itoh4 port)::"?"::req::nil;;


fun cbmain(inet,z,s,reason)=
  let z->[flags srv port req napps first current] in
  if reason==0 then
  (
    mutate z<-[_ _ _ _ _ _ strcat current s];
    0
  )
  else
  let strextr current -> l in
    if !strcmp hd hd l "ok" then
    (
      /*
        if napps==nil then
          set firstping=1
        else nil;
      */
      
      processpile flags tl l;
      set pendingreq=0;
    )
    else if first then
    (
      _fooS "try again via std port";
      startreq flags srv port req napps 0;
    )
    else
    (
      _fooS "cannot reach server";
      set pendingreq=0;
      if napps==nil then nil else
        set nbapps=nbapps+napps;
    );;


fun cbStartReq (url, param, res) =  
  _fooS "cbStartReq"; 
  _fooS strcat "valeur de url :" url; 
  _fooS strcat "valeur de res :" itoa res; 
  
  let param -> [flags srv port req napps first] in 
  if !res then
  (
    _fooS "cannot open url (connection error)";
    set pendingreq = 0;
    if napps == nil
    then
      nil
    else
      set nbapps = nbapps + napps
  )
  else    
    let INETGetURL chn0 _fooS fullurl srv port req first 0 @cbmain [flags srv port req napps first nil] -> url in
      if url == nil
        then
        (
          _fooS "cannot open url (inet error)";
          set pendingreq = 0;
          if napps == nil
          then
            nil
          else
            set nbapps = nbapps + napps
        )
        else
          nil;;


/* flags=masque de
	1 pour se reconnecter sur le dernier site après un update
	2 pour afficher un message si aucune màj disponible */
fun startreq (flags, srv, port, req, napps, first) =
  _fooS "startreq1";
  set pendingreq = 1;
  _rflINETisConnected _fooS strcat "http://" srv @cbStartReq [flags srv port req napps first]; // envoie la requete que si l'on est connecté au net (évite d'afficher la popup d'IE)
  0;;


fun requestn(n)=
  strcat "USE"
  strbuild
  ("tr"::(_getress "License")::nil)::
  ("n"::(itoa n)::nil)::
  nil;;


fun htmlbin3(l,res)=
  if l==nil then res else
  let l->[x n] in
    htmlbin3 n ((nameofpub x)::(ipofpub2 x)::nil)::res;;


fun htmlbin2(l,res)=
  if l==nil then res else
  let l->[a n] in
    htmlbin3 a.pubRun htmlbin2 n res;;
 
 
fun htmlbin()=
  strcat http_headerb strbuild ("name"::(_getress "DefaultName")::nil)::htmlbin2 running nil;;


fun htmldir3(l,res)=
  if l==nil then res else
  let l->[x n] in
    htmldir3 n "<a href=\""::(ipofpub2 x)::"\">"::(nameofpub x)::"</a><br>"::res;; 
 
 
fun htmldir2(l,res)=
  if l==nil then res else
  let l->[a n] in
    htmldir3 a.pubRun htmldir2 n res;;
 
 
fun htmldir()=
  strcatn http_header::"<H1>"::(_getress "DefaultName")::" 's Scol Services</H1><br>\n"::htmldir2 running nil;;


fun htmlreq(con,name)=
  let searchpub running name -> x in
  strcat http_header
  if x==nil then
    if getservhttp==nil then
      "OFF"
    else exec getservhttp with [con name]
  else ipofpub x;;
 
 
fun htmlreqbin(name)=
  let searchpub running name -> x in
    strcat http_headerb if x==nil then "OFF" else ipofpub x;;


fun cbprox(inet,z,s,reason)=
  let z->[con url flag] in
  (
    /*_fooS strcatn ">>>get "::(itoa strlen s)::" bytes from "::url::"("::(itoa reason)::")"::nil;*/
    if reason==0 then
    (
      HTTPsend con s;
      0;
    )
    else
    (
      closeHTTPcon con;
      0;
    )
  );;


fun cbclose_http(con,reqhttp)=
  INETStopURL reqhttp;;


fun htmlproxy(com,url,con,req)=
  if (nth_char url 6)=='C then
    _logfile "proxy"::(getHTTPclientIP con)::nil
  else nil;
  
  if !strcmpi com "GET" then
    let INETGetURL chn0 strcatn "http://"::_hostIP::":"::(itoa htoi substr url 1 4)::url::nil 1 @cbprox [con url 0] -> httpreq in
    if httpreq==nil then
      ""
    else
    (
      rflHTTPclose con @cbclose_http httpreq;
      nil;
    )
  else
    let INETGetURLex chn0 com strcatn "http://"::_hostIP::":"::(itoa htoi substr url 1 4)::url::nil
        (substr req (4+strfind "\13\10\13\10" req 0) strlen req) 1 @cbprox [con url 0]
    -> httpreq in
    if httpreq==nil then
      ""
    else
    (
      rflHTTPclose con @cbclose_http httpreq;
      nil;
    );;


fun http_onrequest(con,x,req)=
  let hd strextr req -> l in
  let l->[com [url _]] in
  if ((nth_char url 0)=='/)&&((nth_char url 5)=='?) then
    htmlproxy com url con req
  else
    let webtostr substr url 0 8 -> url2 in
    if ((nth_char url2 0)=='/)&&((nth_char url2 5)=='?) then
      htmlproxy com strcat url2 substr url 8 strlen url con req
    else if (!strcmpi com "GET") then
      if !strcmp url "/" then
        htmldir
      else if !strcmp url "/?" then
        htmlbin
      else if !strcmp substr url 0 2 "/?" then
        htmlreqbin substr url 2 strlen url
      else
        htmlreq con substr url 1 strlen url
    else
      "";;


/* lancement des serveurs HTTP */
fun launchHTTP(listport)=
	if listport==nil then
	  0
	else
	let listport -> [p n] in
	(
		startHTTPserver chn0 atoi p @http_onrequest nil;
		launchHTTP n;
	);;


fun main(p)=
  // load the usmress.ini
  multiress strextr _loadressini;  
  srand time;

  // load logmaster server
  _load "locked/stdsrvlog.pkg";

  // set the voyager channel
  set chn0 = _channel;  
  
  // get the ip index
  _setLocalIPnumber atoi _getress "localIPindex";
  
  // start the localisation system
  reinitloc;
  
   /*
    _isFirstScol
    2 si lancé en autostart, scol.exe /autostart
    1 si c'est le premier usmwin, 0 sinon.
  */
  
  // si le voyager n'est pas déja dans la liste des processus alors on tente d'ouvrir un port à partir du dernier port connu dans le usmuser.ini
  if (_getScolProcesses > 1) && ((!_isStartMode) || (_isFirstScol)) then
  (
    _closemachine;
  )
  else
  (
    // if the default 1200 port is already used we try to find an unused port
    if (_setserver _envchannel chn0 p "_load \"locked/stdsrvlog2.pkg\"")!=nil then nil else
    (
      //$BB if two voyager are started immediatly (multi ax for example) the first test fail
      if (_isStartMode) then
        _closemachine
      else
      (
        // known free ports
        set p = 49152;
        
        while (_setserver _envchannel chn0 p "_load \"locked/stdsrvlog2.pkg\"")==nil do
        (
          set p = p + 4;
        );
        0;
      );
    );

    // default standar port (1200)
    set port = p;
    
    // get the voyager debug mode
    set voyagerDebugMode = let _getress "voyagerDebugMode" -> n in 
      if n==nil then
        0
      else
        atoi n;
    
    // init custom,history
    initcustserv;
    
    // launch the autostart services app
    launch nil servics;
    
    // set the voyager ID and cache directory
    if (_getress "License") != nil then nil else
      chgress "License" strcat _getress "Origin" BigToAsc BigRand;

    // set the cache directory to the licence name
    _movecache _getress "License";
    
    if (_getress "DefaultName") != nil then nil else
      chgress "DefaultName" strcat "Guest_" (itoa (mod rand 1000));
    
    // init Local http server default port - 1
    startHTTPserver chn0 p-1 @http_onrequest nil;
    
    launchHTTP getInfos (strextr _loadusmini nil) "porthttp";
  
    set _masterchannel = chn0;
    
    _logfile "******************** start ********************"::nil;
    0;
  );
  0;;


fun _killedrun(r,x)=
  /* x!=1 si destruction forcee */
  set running=remove_from_list running r;
  if cbkilled==nil then nil else
    exec cbkilled with [r x];
  if x && r.scriptRun != nil && (_channeltime _channel)>20 then
    launchscript r.scriptRun
  else nil;
  
  if ((sizelist running) > 0) || (voyagerDebugMode == 1) then nil else
    _closemachine;
  0;;


fun _killed(x)=
  let search_in_list running @runbychan _channel -> r in
  if r==nil then nil else
    _killedrun r x;;


fun _closed()=
  _killed 1;;


fun __norestart(x)=
  let search_in_list running @runbychan _channel -> r in
  (
    set r.scriptRun=nil;
    set r.nameRun="norestart";
  );;


fun filter()=
  let _channelIP _channel -> ip in
  if (strcmp ip "127.0.0.1") && (strcmp ip _hostIP) && (strcmp ip "unplugged") then
    1
  else
    0;;


// correct url spaces
fun correctUrl(s)=
  if ((strfindi "https://" s 0) != nil)||((strfindi "http://" s 0) != nil)||((strfindi "file://" s 0) != nil)||((strfind "ftp://" s 0) != nil) then
  (
    let 0 -> pos in
    let " " -> from in
    let "%20" -> to in
    let strlen from -> fsize in
    let strlen to -> tsize in
    if ((fsize <= 0) || (tsize <= 0)) then s else
    while ((set pos = strfind from s pos) != nil) do
      set s = strcatn (substr s 0 pos)::to::(substr s (pos + fsize) ((strlen s) - pos))::nil;
  )
  else nil;
  s;;


fun __register(s)=
  if filter then nil else
  (
    if !strcmp s "vgh" then nil else set nbapps=nbapps+1;
    if (!strcmp substr s 0 2 "__") && (nil!=search_in_list running @runbyname s) then
      _killchannel _channel
    else
    (
      let search_in_script servics @srvbyname s -> p in
      set running=(mkRun[strcat s (if p==nil then "" else " *") _channel p nil nil currunnum])::running;
      set currunnum=currunnum+1;
    );
  );;


fun __goto(s)=
  if filter then nil else
  (
    _closechannel;
    contact (correctUrl s) nil;
    _closed
  );;


fun __gotoA(s)=
  if filter then nil else
  (
    _closechannel;
    launchmachine (correctUrl s) nil;
    _closed
  );;


fun __open(s)=
  if filter then nil else
  (
    contact (correctUrl s) nil
  );;


fun __gotoR(s,r)=
  if filter then nil else
  (
    _closechannel;
    contact (correctUrl s) r;
    _closed
  );;


fun _openR(s,r)=
  if filter then nil else
  (
    contact (correctUrl s) r
  );;


fun __public(s,p)=
  if filter then nil else
  let search_in_list running @runbychan _channel -> r in
  (
    if (sizelist r.pubRun)>9 then nil else set r.pubRun=[s p nil]::r.pubRun;
    if cbpublic==nil then nil else
      exec cbpublic with [s p];
  );;


fun __publicHTTP(s,p)=
  if filter then nil else
  let search_in_list running @runbychan _channel -> r in
  (
    if (sizelist r.pubRun)>9 then nil else
      set r.pubRun=[strcat s "-via_http" nil p]::r.pubRun;
      
    if cbpublichttp==nil then nil else
      exec cbpublichttp with [s p];
  );;


/* fun localinfos2(x,a)=
 let x->[name _ http] in
  _on _channel Cservice [name ipofpub2 x];; */
fun localinfos2(x, param)=	// iri
	let param -> [r ip] in
	let x -> [name porttcp porthttp] in
	let if (porttcp == nil) && (porthttp == nil) then
			nil
		else if porttcp == nil then
			itoa porthttp
		else
			itoa porttcp
		-> p in
	let strcatn "scol://" :: ip :: ":" :: p :: nil -> adr in
	_on _channel Cservice [name adr];;


fun localinfos(r,ip)=
  apply_on_list r.pubRun @localinfos2 [r ip];;


fun __infos(ip)=
  apply_on_list running @localinfos ip;;


fun __getserv(s)=
  let searchpub running s -> x in
  if x==nil && getservdirect!=nil then
    exec getservdirect with [s]
  else
  (
    _on _channel Cservis [s ipofpub x];
    if getservis!=nil then
      exec getservis with [s]
    else nil;
  );;


fun _addc(x,s,r)=
  if r then
  (
    _storepack strcat s _getpack _checkpack  "locked/etc/custom.txt" "locked/etc/custom.txt";
    initcustserv;
    0;
  )
  else nil;;


fun __addcustom(s)=
 if filter || (search_in_script customs @srvbyname s)!=nil then nil else
  _DLGrflmessage _DLGMessageBox chn0 nil loc "ADSRV" strloc loc "ADSM" s::nil 2 @_addc s;;


fun _addres(x,s,r)=
  if r then
  let s->[a b] in
    chgress a b
  else nil;;


fun __address(a,b)=
  if filter then nil else
    _DLGrflmessage _DLGMessageBox chn0 nil loc "ADRS" strloc loc "ADRS?" a::b::nil 2 @_addres [a b];;