%FCGI ;;New Routine created and compiled tools "WEB-MEditor for GT.M" :[27.10.2016 16:16:43]
      ;; Written by Winfried Bantel
      ;; Published under Gnu Public License
START ;
    n $zt s $zt="do errhalt^%FCGI"
    ;s $zt="do Error^%FCGI"
    ;S TCPPORT=$S($G(^FCGI("port"))>0:^("port"),1:9999),TCPIO="|TCP|"_TCPPORT
    s TCPPORT=9999,TCPIO="|TCP|"_TCPPORT
    s nr=0
    o 0:(nowrap)
    d apiInit("listener",TCPPORT)
OPEN w "opening..."_TCPIO,!
    k (TCPIO,TCPPORT,nr)
    OPEN TCPIO:(ZLISTEN=TCPPORT_":TCP":DELIMITER="":ATTACH="listener":NOWRAP):0:"SOCKET" ;; Bantel
    u 0 w "opened",!
    U TCPIO WRITE /LISTEN(0)
LOOP    ;
    u 0 w "Waiting....",! u TCPIO W /WAIT(10) s k=$KEY i k'["CONNECT" g LOOP
    u 0 w k,!
LOOP2    u TCPIO
    r *version,*type,*requestIdB1,*requestIdB0 s requestId=256*requestIdB1+requestIdB0
    r *contentLengthB1,*contentLengthB0,*paddingLength,*reserved
    s contentLength=256*contentLengthB1+contentLengthB0
    s contentData="" i contentLength r contentData#contentLength
    s paddingData="" i paddingLength r paddingData#paddingLength
    u 0 w !,"Type ",type," RequestId=",requestId," l=",$L(contentData),!
    i type=1 s nr=nr+1 d  g LOOP2
    . f i=1:1:contentLength w " ",$A(contentData,i)
    . w !
    i type=4 s %fcgi("i","params")=$G(%fcgi("i","params"))_contentData d:'contentLength  g LOOP2
    . s pos=1 f  q:pos>$L(%fcgi("i","params"))  do
    . . s l1=$A(%fcgi("i","params"),pos),l2=$A(%fcgi("i","params"),pos+1)
    . . s %fcgi("i","header",$E(%fcgi("i","params"),pos+2,pos+2+l1-1))=$E(%fcgi("i","params"),pos+2+l1,pos+2+l1+l2-1)
    . . s pos=pos+l1+l2+2
    . k %fcgi("i","params")
    i type=5 w "Lenght: ",contentLength,!,contentData,! i contentLength>0 s %fcgi("i","stdin")=$G(%fcgi("i","stdin"))_contentData g LOOP2
    ; Jetzt sind alle Daten da
    ;
    s %fcgi("o","header","Set-Cookie")="SID="_$S($G(%fcgi("i","header","SID"))="":($P($H,",")_"00000"+$P($H,",",2))_nr_",1",1:$P(%fcgi("i","header","SID"),",")_","_($P(%fcgi("i","header","SID"),",",2)+1))
     ; ******* SID and Job ????
    s sid=$p($p(%fcgi("o","header","Set-Cookie"),"SID=",2),",",1)
    s ^fcgilog(sid,"SID")=TCPPORT_"`"_$j
    s ^fcgilog("SID")=sid
    i $G(%fcgi("i","header","HTTP_CONTENT_TYPE"))="application/x-www-form-urlencoded" d HTMLVARDECODE(%fcgi("i","stdin"),"%fcgi(""i"",""_POST""")
    i %fcgi("i","header","QUERY_STRING")'="" d HTMLVARDECODE(%fcgi("i","header","QUERY_STRING"),"%fcgi(""i"",""_GET""")
    ;w !,"###############",! zwr %fcgi w !,"###############",!
    ;w $P(%fcgi("i","header","DOCUMENT_URI"),"/",3)
    ; Jetzt auf Programme verteilen
    s t=$G(^FCGI("DOCUMENT_URI",$P(%fcgi("i","header","DOCUMENT_URI"),"/",1,3)))
    w "branch to ",t,!
    d:t'="" @t w:t="" "^FCGI(""DOCUMENT_URI"","""_$P(%fcgi("i","header","DOCUMENT_URI"),"/",1,3)_""") not found",!
    ;
    w !,"###############",! zwr %fcgi w !,"###############",!
    s (ind,txt)="" f  s ind=$O(%fcgi("o","header",ind)) q:ind=""  s txt=txt_ind_": "_%fcgi("o","header",ind)_$C(13,10)
    s txt=txt_$C(13,10)
    u TCPIO
    w $C(1,6,requestIdB1,requestIdB0,$L(txt)\256,$L(txt)#256,0,0),txt
    i $G(%fcgi("o","stdout"))'="" w $C(1,6,requestIdB1,requestIdB0,$L(%fcgi("o","stdout"))\256,$L(%fcgi("o","stdout"))#256,0,0),%fcgi("o","stdout")
    w $C(1,6,requestIdB1,requestIdB0,0,0,0,0) ; stdout Complete
    w $C(1,3,requestIdB1,requestIdB0,0,8,0,0),$C(0,0,0,0,0,0,0,0) ; Request Complete
    u 0 c TCPIO g OPEN
    ;
record(type,data)   ; Not used
    w $C(1,type,requestIdB1,requestIdB0,$L(data)\256,$L(data)#256,0,0)_data
    q
    ;
init    ;  Not used
    n (fcgi)
    s fcgi("type",1,"FCGI_BEGIN_REQUEST")=1
    s fcgi("type",1,"FCGI_ABORT_REQUEST")=2
    s fcgi("type",1,"FCGI_END_REQUEST")=3
    s fcgi("type",1,"FCGI_PARAMS")=4
    s fcgi("type",1,"FCGI_STDIN")=5
    s fcgi("type",1,"FCGI_STDOUT")=6
    s fcgi("type",1,"FCGI_STDERR")=7
    s fcgi("type",1,"FCGI_DATA")=8
    s fcgi("type",1,"FCGI_GET_VALUES")=9
    s fcgi("type",1,"FCGI_GET_VALUES_RESULT")=10
    s fcgi("type",1,"FCGI_UNKNOWN_TYPE")=0
    ;
HTTPSTATUS401(realm)
    s %fcgi("o","header","Status")="401 Unauthorized" ;
    s %fcgi("o","header","WWW-Authenticate")="Basic realm="""_realm_"""" ;
    s %fcgi("o","header","Content-Type")="text/plain",%fcgi("o","stdout")="Unauthorized"
    q
    ;
HTMLVARDECODE(data,var)  ; Decodiert nach HTML-Variablen-Standard
    w data,!,var,!
    n l,i,ind,val,t
    s l=$L(data,"&") f i=1:1:l s t=$P(data,"&",i) d
    . ;s ind=$$CONVERT($TR($P(t,"="),lower,upper)),val=$$CONVERT($P(t,"=",2))
    . s ind=$$CONVERT($P(t,"=")),val=$$CONVERT($P(t,"=",2))
    . i $L(ind) s @(var_","""_ind_""")")=val w ind,": ",val,!
    q
    ;
HEX2DEZ(dez)  ;
    n (dez) s hex=0,dez=$TR(dez,"abcdef","ABCDEF")
    f i=1:1:$L(dez) s hex=hex*16+$s($A(dez,i)>59:$A(dez,i)-55,1:$E(dez,i))
    q hex
    ;
CONVERT(t)  ;
    n (t)
    s t=$TR(t,"+"," "),p=0
    f  s p=$F(t,"%",p) q:p<1  s t=$E(t,1,p-2)_$C($$HEX2DEZ($E(t,p,p+1)))_$E(t,p+2,255)
    q t
    ;
out(txt) ;
 s %fcgi("o","stdout")=%fcgi("o","stdout")_txt
 q
 ;; 
apiInit(server,port)
 s ^fcgilog(server,"FCGISERVER")=port_"`"_$j
 q    
 ; 
Error
 s $zt=""
 s %fcgi("o","stdout")=%fcgi("o","stdout")_" <script type=""text/javascript"">"_$c(10)
    s $et="",$ec="",$zt=""
    s output=$zs
    s $zs=0
 s %fcgi("o","stdout")=%fcgi("o","stdout")_" alert ("""_output_""")"_$c(10)
 s %fcgi("o","stdout")=%fcgi("o","stdout")_" </script>"_$c(10)
 ;d out(%fcgi("o","stdout"))
 ;c TCPIO g START
 q
 ;;
errhalt()
 ;;The error handler to stop. You can see the error in the file and that happened.
 ;;
 set $ztrap="errhalt"
 new file,dev
 set dev=$io
 set file="/usr/errsocket.log"
 open file:(append:nofixed:wrap:noreadonly:chset="M")
 use file
 write "Error at "_$horolog,!,$zstatus,!
 zshow "SIDV"
 close file
 use dev
 halt
 q
 ;;

FCGIUCI ;;New Routine created and compiled tools "WEB-MEditor for GT.M" :[29.11.2016 09:05:42]
 s nms=$P(%fcgi("i","header","DOCUMENT_URI"),"/",4)
 s dir=$P(%fcgi("i","header","DOCUMENT_URI"),"/*",2)
 s:nms=1 nms="SYS"
 s n=0
 i %fcgi("i","header","REQUEST_METHOD")="GET" d GET(dir,nms) q
 ;;
GET(SYSGLB,namespace)
 ; SYSGLB - system path(^sysconfig $gtm_dist)
 ; namespace - (cadre - by example)
 s id=""
 s sid=$p(%fcgi("i","header","SID"),",")
 s ^uciID(sid)=""
 s ^uciID(sid,"oldzro")=$zro
 s ^uciID(sid,"oldzgb")=$zgb
 f  s id=$o(^uciID(id)) q:id=""  d
 . s dirrtn=^|SYSGLB|sysconfig(namespace,"r") ; return directory(r) to call routines
 . s GLD=^|SYSGLB|sysconfig(namespace,"gld")
 . s PATH=^|SYSGLB|sysconfig(namespace,"patch")
 . i id=sid d
 . . s ^uciID(sid,"newzro")=PATH
 . . s ^uciID(sid,"newzgb")=GLD
 . . s %fcgi("o","stdout")=dirrtn_$c(13,10)
 . . s %fcgi("o","header","Content-Type")="text/plain"
 q
 ;;

startappl(appl)
 n (appl,%fcgi)  ;здесь может что ещё нужно вставить, что надо 
 ;сохранить $zg и , если надо $zro
 ;установить нужные $zg, $zro (здесь как раз cid и может пригодиться)
 ;настроить обработчик ошибок, если нужно
 s sid=$p(%fcgi("i","header","SID"),",")
 i '$d(^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzro")) s ^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzro")=$zro
 i '$d(^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzgb")) s ^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzgb")=$zgb
 s $zro=^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzro")
 s $zgb=^|"/usr/gtm63A/mumps.gld"|uciID(sid,"newzgb")
 d @appl
 ;восстановить $zg,$zro
 s $zro=^|"/usr/gtm63A/mumps.gld"|uciID(sid,"oldzro")
 s $zgb=^|"/usr/gtm63A/mumps.gld"|uciID(sid,"oldzgb")
 q
 ;

 o tcpdev:(ZLISTEN=port_":TCP":NODELIMITER:ZNODELAY:ATTACH="listener"):timeo:"SOCKET"
 e  s ^fcgilog($job)="-1,NotOpen" q
 ;u tcpdev:morereadtime=100
 u tcpdev
 w /listen(1)
 f  d  q:$key]""
 . w /wait(timeo)
 . i $key]"" q
 s socket=$p($key,"|",2)
 c tcpdev:(SOCKET="listener") j listen^test
loop 
 u tcpdev:(NODELIMITER:ZNODELAY:SOCKET=socket)
 ....
 ....
 w $C(1,3,requestIdB1,requestIdB0,0,8,0,0),$C(0,0,0,0,0,0,0,0) ; Request Complete
 s nr=0
 c tcpdev:(SOCKET=socket)
 u tcpdev