/* browser SCOL 1.0 */
defcom CrestartUpd=restartUpd S;;

var stdport1="8080";;
var stdport2="80";;

typeof screen=Chn;;
typeof win=ObjWin;;
typeof winAX=ObjWin;;
typeof message=ObjText;;
typeof site=ObjText;;
typeof barre=ObjBitmap;;

typeof server=Chn;;

defcom Smainapplet=main S S;;
defcom Sipreq=ipreq S;;

proto contact=fun[S] I;;

var sizeload=1;;
var sizeloaded=0;;
var rights=0;;
typeof ContactS=S;;

typeof NEXTtry=S;;
typeof URLservice=S;;
typeof req1=INET;;
typeof req2=INET;;

typeof tim=Timer;;
typeof remain=I;;

fun multiress(res)=
  if res==nil then
    0
  else
    let res ->[l nxt] in
    (
      _setress hd l hd tl l;
      multiress nxt;
    );;


fun isIP(s, i)=
  if i>=strlen s then
    1
  else
  let nth_char s i-> a in
    if a!='. && (a<'0 || a>'9) then
      0
    else
      isIP s i+1;;


fun isPORT(s, i)=
  if i>=strlen s then
    1
  else
  let nth_char s i-> a in
    if a<'0 || a>'9 then
      0
    else
      isPORT s i+1;;


fun getip(a)=
  if a==nil || !strlen a then
    "127.0.0.1"
  else if isIP a 0 then
    a
  else
  (
    _SETtext message strloc loc "LOOKUP" a::nil;
    _gethostbyname a;
  );;


fun cutbyslash(s, i)=
  if i>=strlen s then
    if i==0 then nil else s::nil
  else if (nth_char s i)=='/ then
    (substr s 0 i)::cutbyslash substr s i+1 1000 0
  else
    cutbyslash s i+1;;


fun cutbypoints(s, i)=
  if i>=strlen s then
    if i==0 then nil else s::nil
  else if (nth_char s i)==': then
    (substr s 0 i)::cutbypoints substr s i+1 1000 0
  else
    cutbypoints s i+1;;


fun convertp(l)=
  if l==nil then nil else
  let l->[a n] in
    (hd strextr webtostr a)::convertp n;;


fun retryFirewall()=
  if !strcmpi _getress "Firewall" "strong" then
  (
    _SETtext message strloc loc "BADAD" URLservice::nil;
    nil;
  )
  else
  (
    _setress "Firewall" "strong";
    contact NEXTtry;
  );;


fun stoptry()=
  _deltimer tim;
  INETStopURL req1;
  INETStopURL req2;;


fun _time(tim, b)=
  _SETtext message strloc loc "TIMEOUT" URLservice::(itoa remain)::nil;
  set remain=remain-1;
  if remain>=0 then nil else
  (
    stoptry;
    retryFirewall;
  );;


fun wait()=
 set remain=10;
 set tim=_rfltimer _starttimer screen 1000 @_time 0;
 0;;


fun cb(inet, z, s, reason)=
  let z->[curres cport] in
  if reason==0 then
  (
    mutate z<-[strcat curres s _];
    0;
  )
  else if reason==1 then
  let substr curres 0 7 -> z in
  if (!strcmpi z "scol://")||(!strcmpi z "http://") then
  (
    stoptry;
    _setress "FirewallPort" cport;
    contact curres;
  )
  else if !strcmpi curres "OFF" then
  (
    stoptry;
    _SETtext message loc "NOTAVAIL";
    nil;
  )
  else
  (
    _deltimer tim;
    retryFirewall;
    nil;
  )
  else
  (
    _deltimer tim;
    retryFirewall;
    nil;
  );;


/* essai via http */
fun tryviahttp(ad, name)=
  if strcmpi _getress "Firewall" "strong" then
  let strcatn "http://"::ad::":1199/"::name::nil ->url in
  (
    set URLservice=url;
    set NEXTtry=strcatn "scol://"::ad::":"::name::nil;
    let strcat strcat ad "." name -> s in
      _setCookies substr s (strlen s)-10 10;
      
    _SETtext message strloc loc "CONT" name::nil;
    set req1=INETGetURL screen url 0 @cb [nil nil];
    if req1==nil then
    (
      retryFirewall;
      0;
    )
    else
      wait;
  )
  else
  let [strcatn "http://"::ad::":"::nil strcat "/" name] ->[pref suff] in
  (
    set URLservice=strcatn "http://"::ad::"/"::name::nil;
    _setCookies strcat strcat ad "." name;
    _SETtext message strloc loc "CONT" name::nil;
    set req1=INETGetURL screen strcat strcat pref stdport1 suff 0 @cb [nil stdport1];
    set req2=INETGetURL screen strcat strcat pref stdport2 suff 0 @cb [nil stdport2];
    if req1==nil && req2==nil then
    (
      _SETtext message strloc loc "BADAD" URLservice::nil;
      0;
    )
    else
      wait;
  );;


/* essai adresse:nom (port du scol engine)*/
fun tryscoldns(ad, name, cport)=
  set NEXTtry=strcatn ad::":"::name::"-via_http"::nil;
  let getip ad -> ip in
  if ip==nil then
  (
    contact NEXTtry;
    0;
  )
  else
  let strcat ip if cport==nil then ":1200" else strcat ":" cport -> cor in
  (
    set URLservice=strcatn ad::":"::name::nil;  
    _SETtext message strloc loc "SOLV" ip::name::nil;
    if (_openchannel cor strcat "_load \"locked/iprequest.pkg\"\n" mkscript Sipreq [name] _envchannel screen)==nil then
    (
      contact NEXTtry;
      0;
    )
    else 0;
  );;


/* essai adresse:port */
fun trydirect(ad, cport)=
  let getip ad -> ip in
  if ip==nil then
  (
    _SETtext message strloc loc "BADAD" ad::nil;
    0;
  )
  else
  let strcat strcat ip ":" cport -> cor in
  (
    _SETtext message strloc loc "CONT" cor::nil;
    _setCookies strcat strcat ad "." cport;
    set server = _openchannel cor "_load \"locked/stdusr2.pkg\"" _envchannel screen;
    if server==nil then
    (
      _SETtext message strloc loc "BADAD" cor::nil;
      0;
    )
    else 0;
  );;


/* contact scol */
fun contact2(s)=
  let cutbyslash s 0 ->[ad params] in
  (
    if params==nil then nil else
      _setress "parameters" strbuild convertp params;
  
    let cutbypoints ad 0 -> [a [x [c _]]] in
    let if x==nil then "1200" else x -> b in
    if isPORT b 0 then
      trydirect a b
    else if strcmp substr b (strlen b)-9 9 "-via_http" then
      tryscoldns a b c
    else
    tryviahttp a b;
  );;


fun _endV(a, b, r)=
  if r then
  (
    // Bastien mise a jour verif php
    // Check Scol update
    _on _masterchannel CrestartUpd [ContactS]
  )
  else
  (
    _closemachine
  );;


fun __badversion()=
  _closechannel;
  _DLGrflmessage _DLGMessageBox screen win loc "DECNX" 
  loc "TOOOLD" 2 @_endV 0;
  0;;

fun _end(t, u)=
	_closemachine;;


fun contact(s)=
  if !strcmp substr s 0 7 "http://" then (_openbrowserhttp s; _rfltimer _starttimer screen 3000 @_end 0; 1)
  else
  (
    if !strcmp substr s 0 14 "scol://applet:" then
    (
      set ContactS=s;
      _load "locked/stdapplt.pkg";
      _script mkscript Smainapplet [substr s 14 strlen s "100"];
    )
    else if !strcmp substr s 0 19 "scol://applet/?app=" then
    (
      set ContactS= strcat "scol://applet:" (substr s 19 strlen s);
      _load "locked/stdapplt.pkg";
      _script mkscript Smainapplet [substr s 19 strlen s "100"];
    )
    else if !strcmp substr s 0 7 "scol://" then
    let strfindi "/?app=" s 0 -> appos in
    (
      if appos == nil then
      (
        set ContactS= s;
        contact2 substr s 7 strlen s;
      )
      else
      (
        set ContactS= strcatn (substr s 0 appos)::":"::(substr s appos + 6 strlen s)::nil;
        contact2 substr ContactS 7 strlen ContactS;
      );
    )
    else contact2 s
  );;

fun _destroyevent(a,b)=_closemachine;;

fun _paintevent(a,b)= _BLTbitmap win barre 5 30;;


fun cbWinAxSize(winax, p, w, h)=
  _SIZEwindow win w h 0 0;
  _SIZEtext site (w-10) 20 5 5;
  _SIZEtext message (w-10) 40 5 30;
  _DSbitmap barre;
  set barre=_CRbitmap screen (w-10) 20;
  _DRAWrectangle barre 0 0 (w-9) 21 DRAW_SOLID 2 0 DRAW_SOLID 0xffffff;
  _DRAWrectangle barre 5 5 (w-10)*sizeloaded/sizeload 10 DRAW_INVISIBLE 0 0 DRAW_SOLID 0xff;
  _paintevent nil nil;
  0;;


fun cbWinAxDestroy(winax, p)=
  _closemachine;
  0;;


fun mainEx(name, r, s, versionmin)=
  startloc "locked/lang/master";
  _SETdefaultFont _CRfont _channel 14 0 0 loc "FONT";
  set rights=r;
  multiress strextr s;
  _setress "firsturl" name;
  set screen=_channel;
  
  set winAX = _GETactiveXWindow screen 0 "axscol";
  _CBwinDestroy winAX @cbWinAxDestroy nil;
  _CBwinSize winAX @cbWinAxSize nil;
  
  let if winAX != nil then _GETwindowPositionSize winAX else [80 80 310 100] -> [x y w h] in
  (
    set win = _CRwindow screen winAX x y w h (if winAX != nil then WN_CHILDINSIDE else WN_MENU|WN_MINBOX) name;
    _CBwinDestroy win @_destroyevent 0;
    _CBwinPaint win @_paintevent 0;
    set site=_CRtext screen win 5 5 (w-10) 20 ET_ALIGN_CENTER+ET_BORDER name;
    set barre=_CRbitmap screen (w-10) 20;
    set message=_CRtext screen win 5 55 (w-10) 40 ET_ALIGN_CENTER+ET_AHSCROLL strloc loc "CONT" name::nil;
    _DRAWrectangle barre 0 0 (w-9) 21 DRAW_SOLID 2 0 DRAW_SOLID 0xffffff;
    _paintevent nil nil;
  );
  
  if (_version<versionmin) then
    __badversion
  else
    contact name;;


fun main(name, r, s)=
  mainEx name r s 0;;