defcom CrestartUpd=restartUpd S;; var stdport1="8080";; var stdport2="80";; typeof screen=Chn;; typeof win=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 rights=0;; typeof ContactS=S;; 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;; typeof NEXTtry=S;; typeof URLservice=S;; typeof req1=INET;; typeof req2=INET;; typeof tim=Timer;; typeof remain=I;; 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 port] 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" port; contact curres) else if !strcmpi curres "OFF" then (stoptry; _SETtext message loc "NOTAVAIL";nil) else (_deltimer tim; retryFirewall;nil) else (_deltimer tim; retryFirewall;nil);; 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);; fun tryscoldns(ad,name,port)= 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 port==nil then ":1200" else strcat ":" port -> 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);; fun trydirect(ad,port)= let getip ad ->ip in if ip==nil then (_SETtext message strloc loc "BADAD" ad::nil;0) else let strcat strcat ip ":" port -> cor in (_SETtext message strloc loc "CONT" cor::nil; _setCookies strcat strcat ad "." port; set server= _openchannel cor "_load \"locked/stdusr2.pkg\"" _envchannel screen; if server==nil then (_SETtext message strloc loc "BADAD" cor::nil;0) else 0);; 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 ( _on _masterchannel CrestartUpd [ContactS] ) else ( _closemachine );; fun __badversion()= _closechannel; _DLGrflmessage _DLGMessageBox screen win loc "DECNX" loc "TOOOLD" 2 @_endV 0; 0;; fun contact(s)= if !strcmp substr s 0 7 "http://" then (_openbrowserhttp s; _closemachine) else ( set ContactS=s; if !strcmp substr s 0 14 "scol://applet:" then (_load "locked/stdapplt.pkg"; _script mkscript Smainapplet [substr s 14 strlen s "100"]) else if !strcmp substr s 0 7 "scol://" then contact2 substr s 7 strlen s else contact2 s );; fun _destroyevent(a,b)=_closemachine;; fun _paintevent(a,b)= _BLTbitmap win barre 5 75;; fun mainEx(name,r,s,versionmin)= startloc "locked/lang/master"; _SETdefaultFont _CRfont _channel 14 0 0 loc "FONT"; set rights=r; multiress strextr s; set screen=_channel; set win=_CRwindow screen nil 80 80 310 100 WN_MENU+WN_MINBOX name; _CBwinDestroy win @_destroyevent 0; _CBwinPaint win @_paintevent 0; set site=_CRtext screen win 5 5 300 20 ET_ALIGN_CENTER+ET_BORDER name; set message=_CRtext screen win 5 30 300 40 ET_ALIGN_CENTER+ET_AHSCROLL strloc loc "CONT" name::nil; set barre=_CRbitmap screen 300 20; _DRAWrectangle barre 0 0 301 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;;
