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

/* cDHDMS - mar 00 - by Sylvain HUET */
/* communication part */


/* communication with server */
var httpmode=0;;
var xhttp=0;;
typeof bufHTTPin=S;;
var fis=0;;
typeof bufHTTPout=[S r1];;
var nummsg=0;;
typeof lastmsg=S;;
typeof urlhttp=S;;
typeof urlhttpdownload=S;;

fun is_hexa(s)=
  if (strlen s)<=0 then 1
  else let nth_char s 0 -> c in
    if ((c >= '0) && (c <= '9)) ||
       ((c >= 'a) && (c <= 'f)) ||
       ((c >= 'A) && (c <= 'F)) then
      is_hexa substr s 1 (strlen s)-1
    else 0
;;

fun errHTTP(s)=
 _fooS "######ERROR_HTTP";
 _fooS s;
 let DMSserver -> chn in (
  _scriptc DMSserver "_closed";
  _killchannel chn
 );
 0;;

/* HTTP server->client */
/* return 1 => continue http dialog */
fun execHTTP(s)=
  if (strlen bufHTTPin)>=8 then let substr bufHTTPin 0 8 -> lg in
    if is_hexa lg then let htoi lg -> l in
      if (strlen bufHTTPin)>=8+l then
        let substr bufHTTPin 8 l ->scr in (
          set bufHTTPin=substr bufHTTPin 8+l strlen bufHTTPin;
          _scriptc DMSserver scr;
          execHTTP s
        )
      else 1
    else errHTTP "execHTTP"
  else 1;;

var contflag=0;;

proto cbgetHTTP=fun[INET u0 S I] I;;

fun restarthttp()=
 set contflag=0;
 if nil==INETGetURL DMSserver strcatn urlhttp::"N"::(itoh8 xhttp)::nil 0 @cbgetHTTP nil
 then errHTTP "nextHTTP" else nil;;
 
fun cbgetHTTP(inet,a,s,reason)=
/* _fooS strcatn "####Http reception "::(itoa strlen s)::" "::(itoa reason)::nil;*/
 if (reason==0) then
 (set bufHTTPin=strcat bufHTTPin s;
  set contflag=execHTTP s)
 else nil;
 if (reason) then
  if contflag then restarthttp
  else errHTTP "cbgetHTTP"
 else nil;
 0;;

/* HTTP client->server */

proto fis_signal=fun[] I;;

typeof curget=S;;
fun cbgetSend(inet,a,s,reason)=
/* _fooS strcatn ">>>>Http reception send "::(itoa strlen s)::" "::(itoa reason)::nil;*/
 if (reason==0) then
 (set curget=strcat curget s;
  0)
 else if reason==1 && !strcmp curget "FIS" then
 (set nummsg=nummsg+1;
  set lastmsg=nil;
  fis_signal)
 else if lastmsg==nil then errHTTP "cbgetSend"
 else
 (set bufHTTPout=lastmsg::bufHTTPout;
  fis_signal);
 0
;;

fun flush_http()=
/* _fooS ">>>flush_http";*/
 set curget=nil;
 if nil==INETGetURLex DMSserver "POST" strcatn urlhttp::"S"::(itoh8 xhttp)::(itoh4 nummsg)::nil hd bufHTTPout 0 @cbgetSend 0
  then errHTTP "flush" else nil;
 set lastmsg=hd bufHTTPout;
 set bufHTTPout=tl bufHTTPout;
 set fis=0;;

fun fis_signal()=
 set fis=1;
 if bufHTTPout!=nil then flush_http
 else nil
;;

fun add_http(l,msg)=
 if l==nil then msg::nil
 else let l->[a n] in
 if n!=nil then a::add_http n msg
 else if ((strlen a)+(strlen msg))<4096 then (strcat a msg)::nil
 else a::msg::nil;;

fun send_http(msg)=
/* _fooS ">>send_http :";*/
 set bufHTTPout=add_http bufHTTPout strcat "__" mkscript msg;
 if fis then flush_http
 else nil;;
 
fun _on_(srv,msg)=
 if DMSoff then nil
 else if httpmode then send_http msg
 else _on DMSserver msg;;


fun cbupload(inet,z,s,reason)=
 let z->[cur cb] in
 if reason then exec cb with [if reason==1 && !strcmp cur "FIS" then 1 else 0]
 else
 (mutate z<-[strcat cur s _];
  0);;

fun _upload_(d,name,content,cb)=
 if nil==INETGetURLex DMSserver "POST" strcatn urlhttp::"U"::(itoh8 xhttp)::(itoh4 d.numDMI)::(strtoweb name)::nil
  content 0 @cbupload [nil cb]
  then exec cb with [0]
 else nil;;

/* initialization of globals */

fun DMSmultiress(res)=
 if res==nil then 0
 else let res ->[l nxt] in
 (if (sizelist l)<2 then _setress "enter" hd l else _setress hd l hd tl l;
  DMSmultiress nxt);;

fun DMSinitglobals()=
 set DMSenv=_envchannel _channel;
 set DMSserver=_channel;
 DMSmultiress strextr _getress "parameters";;

/* initialization of connexion */

var stdport="8080";;

fun defurlhttp(ip,port)=
 _fooS "connection address";
 let if !strcmpi _getress "Firewall" "strong" then _getress "FirewallPort" else (itoa port) -> x in
 _fooS set urlhttp=strcatn "http://"::ip::":"::(if x==nil then stdport else x)
  ::"/"::(itoh4 port)::"?"::nil;;



fun defurlhttpdownload(download_name,download_port)=
 _fooS "download address";
 _fooS set urlhttpdownload=
  if download_name==nil then urlhttp
  else
   let if !strcmpi _getress "Firewall" "strong" then _getress "FirewallPort" else (itoa download_port) -> x in
   strcatn "http://"::download_name::":"::(if x==nil then stdport else x)
    ::"/"::(itoh4 download_port)::"?"::nil;;


fun iniDIRECT()=
 set DMSreconnect=_channelname _channel;
 defurlhttp _channelIP _channel 1+_channelport _channel;
 0;;
 
fun iniHTTP(url,port)=
 set httpmode=1;
 set DMSreconnect=strcatn "scol://applet:http://"::url::":"::(itoa port)::"/"::(itoh4 port)::"?X"::nil;
 defurlhttp url port;
 if nil==INETGetURL DMSserver strcatn urlhttp::"C"::nil 0 @cbgetHTTP nil
  then errHTTP "iniHTTP" else nil;
 0;;

fun _DMSreset()=
 exitgracefully;
 _killchannel DMSserver;
 set DMSserver=nil;
 0;;

fun main()=
/* _showconsole;*/
 DMSinitglobals;
 iniDIRECT;
 _DMSiniW 320 200 0;;

fun mainHTTP(ip,port)=
/* _showconsole;*/
 DMSinitglobals;
 iniHTTP ip port;
 _DMSiniW 320 200 1;;

/* API */
fun _COMurlDownload(d,name,acces)=
/* _showconsole;
 _fooS "##Download";
 set urlhttpdownload="http://127.0.0.1:5000/xxxx?";*/
 _fooS 
  strcatn (if acces==nil then urlhttpdownload else urlhttp)  /* choix du serveur de download : relai ou direct */
   ::"D"::(itoh8 xhttp)::(itoh4 d.numDMI)::(strtoweb name)::nil;;



/* external */
fun _closed()=
 let _openchannel nil "" DMSenv -> newchn in
 (_chgchn DMSserver newchn;
  set DMSserver=newchn);
 _fatalError _loc _DMSrootModule "DCNX" nil _loc _DMSrootModule "DCNX_TXT" nil;;

fun _endV(a,url,r)=
 set DMSoff=1;
 exitgracefully;
 if r then 
  _on _masterchannel Cgoto [url]
 else _closemachine;;

fun __badVersion(title,text,url)=
 let _openchannel nil "" DMSenv -> newchn in
 (_chgchn DMSserver newchn;
  _killchannel DMSserver;
  _DLGrflmessage _DLGMessageBox newchn DMSwin title text 2 @_endV url);;

typeof DMSlasttime=I;;

fun _clockE(a,i)=
 if (time-DMSlasttime)>i then
 (_deltimer a;
  _closed)
 else nil;;

fun iniTimeout(i)=
 set DMSlasttime=time;
 if i==nil || i<=0 then nil
 else _rfltimer _starttimer _channel i*500 @_clockE i;
0;;

/* para supplémentaires: serveur et port de download */
/* modif 0102 */
fun __init(x,nb,name,timeout,tim,tick,predmiclient,barback,barfore,bartext,download_name,download_port)=
 set DMSnbDmi=nb;
 set DMSdmi=mktab DMSnbDmi nil;
 set DMSname=name;
 set xhttp=x;
 set preDMI=predmiclient;
 defurlhttpdownload download_name download_port;
 _DMSsettime tim tick;
 iniTimeout timeout*2;
 _BARsetColor barback barfore bartext;
 fis_signal;
 _on_ nil Clang [strlowercase _getress "DefaultLanguage"];;

fun __hookInactive(s)= MODhookInactive strextr s;;

fun logon2(s,file)=
 if s==nil && file!=nil then getFileErr s file
 else
 (_DOCparse file;
  _on_ nil Center [DOCactiveX _version _versionname _getress "License" _getress "enter"]);;

fun __logon(login,id,file)=
 set DMSlogin=login;
 set DMSid=id;
 _RSCdownload _DMSrootModule file file mknode @logon2 file 3;;

fun __ping()=
 set DMSlasttime=time;
 _on_ nil Cping[];;

fun __service(s)=_DLGMessageBox DMSserver DMSwin _loc _DMSrootModule "SERVICE_MSG" nil s 0;;
 
fun __delete(i)=MODdelete i;;
fun __send(i,c)=_DMSreceive i c;;
fun __action(i,j,act,par,rep,ulist,tag)= _DMSaction i j act par rep ulist tag;;
fun __deltag(i)=_deltag i;;
fun __firetag(i,param,ulist)=_firetag i param ulist;;
fun __purgeHook(i,n)=purgeHook i n;;
fun __reinitLoc(i)=reinitLoc i;;