GTMLINK(port)  ;GT.M Link Server - by paulo.rogerio@zipmail.com.br  ; Compiled April 3, 2007 11:16:22
  ;Based on Socket Examples from fscwitte@users.sourceforge.net
  ; NO ^ROUTINE ENTRY
  n ver
  s:port="" port=8000
  s ver=$e($zv,1,10)
    i ver["GT.M" j START^%MLINK(port) q
    i ver["Cache" j srv^%MLINK(port) q
  QUIT
  ;
START(%ZNPort)  ;Start the Server
  ;S %ZNPort=800
  S %ZNDev="SCK$"_$J
  O %ZNDev:(ZLISTEN=%ZNPort_":TCP":NODELIMITER:ATTACH="listener"):60:"SOCKET"
  E  Q
  ; USE fills $KEY with "BOUND|socket_handle|portnumber"
  U %ZNDev
  ;
  ; Start listening, sets $KEY to "LISTENING|socket_handle|portnumber"
  W /LISTEN(1)
  ;
  ; Wait for connection, $KEY will be "CONNECT|socket_handle|remote_ipaddress"
1  ;
  F  D  q:$KEY]""
  . W /WAIT(60)
  . I $KEY]"" Q
  ;
  ; Store the connection socket in local variable,
  S %ZNSock=$piece($KEY,"|",2)
  C %ZNDev:(SOCKET="listener") J START^GTMLINK ;close listener and start another GT.M Link to listen port
  S $ZTRAP="GOTO ERROR^GTMLINK"
2  U %ZNDev:(SOCKET=%ZNSock)
  W "glc_READY:",$c(0)
  ;
  s qqnump=$j
  s qW=##class(%Library.qWORD).%New()
    s qARM=##class(%Library.TqARM).%New()
    s qqlang=1
3  F  D          
  . s %ZNData=$$GETDATA() q:%ZNData=""
  . i %ZNData="" q
  . q:%ZNData=$c(1)
  . I %ZNData="glc_EXIT:" W "glc_DISCONNECTED:",$c(0) s ^tmplink("close",$j)=$h_"~EXIT" C %ZNDev H
  . I $P(%ZNData,":",1)="glc_EXECUTE" D
  .. W $c(1,2,3,4,5,6,7,8,9)
  .. I %ZNData["getsessionid=1" k:$d(^%session($JOB)) ^%session($JOB) s ^%session($JOB)=$h
  .. F %ZTemp=0:1:9 s %Var="P"_%ZTemp,@%Var=$p(%ZNData,$c(1),%ZTemp+2)
  .. S %ZNCommand=$P($P(%ZNData,":",2,9999),$c(1),1)
  .. S:%ZNCommand[($c(5)_"xmldata=1") %ZNCommand=$p(%ZNCommand,$c(5)_"xmldata=1",1)
  .. S P9=""  
  .. X:%ZNData'["getsessionid=1" %ZNCommand
  .. s:%ZNData["getsessionid=1" P0=$JOB
  .. F %ZTemp=0:1:9 S %Var="P"_%ZTemp I '$D(@%Var) S @%Var=""
  .. W "glc_EXRESPONSE:<registry>",P0,$C(1),P1,$C(1),P2,$C(1),P3,$C(1),P4,$C(1),P5,$C(1),P6,$C(1),P7,$C(1),P8,$C(1),P9,$c(1)
  .. W $c(9,8,7,6,5,4,3,2,1)
  s ^tmlink("close",$j)=$h
  C $I
  H
GETDATA()  
        n c,d,end,c1
        S (d,end,c1,c)=""
        d FINDST
        f  d  q:end=1
        .R *c:60 q:'$T
        .S d=d_$C(c)
        .S c1=c1_c
        .s:c1[987654321 d=$p(d,$c(9,8,7,6,5,4,3,2,1),1),end=1
        .q
        s ^tmlink("open",$j)=d
        q d
FINDST  
        n c,end,str
        s (c,end,str)=""
        f  d  q:end=1
        .R *c:60 q:'$T
        .q:(c<1)!(c>9)
        .s str=str_c
        .s:str[123456789 end=1
        .q
        q
ERROR  ;
  W $c(1,2,3,4,5,6,7,8,9)
  F %ZTemp=0:1:9 S %Var="P"_%ZTemp I '$D(@%Var) S @%Var=""
  s ^GTMERROR($j,$h)=$TR($ZSTATUS,$C(13,10),"")
  U %ZNDev:(SOCKET=%ZNSock)
  W "glc_ERROR:"_$TR($ZSTATUS,$C(13,10),""),$C(1),"<registry>",P0,$C(1),P1,$C(1),P2,$C(1),P3,$C(1),P4,$C(1),P5,$C(1),P6,$C(1),P7,$C(1),P8,$C(1),P9,$C(1),$c(9,8,7,6,5,4,3,2,1)
  g 3
sererror
  W $c(1,2,3,4,5,6,7,8,9)
  F %ZTemp=0:1:9 S %Var="P"_%ZTemp I '$D(@%Var) S @%Var=""
  s ^GTMERROR($j,$h)=$ZERROR
  W "glc_ERROR:"_$zerror,$C(1),"<registry>",P0,$C(1),P1,$C(1),P2,$C(1),P3,$C(1),P4,$C(1),P5,$C(1),P6,$C(1),P7,$C(1),P8,$C(1),P9,$C(1),$c(9,8,7,6,5,4,3,2,1),*-3 
  g 4
srv(port)
    n dev,mode,jobflag,id,end
    S dev="|TCP|"_port
 // 4 transfer to job open socket        
   s $zt="error" 
   S mode="AS" 
   s end=""
   S jobflag=4
   O dev:(:port:mode::32767:32767) 
   f  d  q:end=1
   .U dev R x:30 // wait connection
   .i $T J srvj(port):(:jobflag:$IO:$IO):0 s end=1
   .q
error
  c dev  
  j srv^%MLINK(port)
 q
srvj(port)
  n id,in,d,str,dev
  s $zt="sererror"
  s d=""
  W "glc_READY:"_$c(0),*-3  
4 F  D          
  . s %ZNData=$$GETDATA() q:%ZNData=""
  . i %ZNData="" q
  . q:%ZNData=$c(1)
  . I %ZNData="glc_EXIT:" W "glc_DISCONNECTED:",$c(0) s ^tmplink("close",$j)=$h_"~EXIT" H
  . I $P(%ZNData,":",1)="glc_EXECUTE" D
  .. s value=""
  .. W $c(1,2,3,4,5,6,7,8,9)
  .. I %ZNData["getsessionid=1" k:$d(^%session($JOB)) ^%session($JOB) s ^%session($JOB)=$h
  .. F %ZTemp=0:1:9 s %Var="P"_%ZTemp,@%Var=$p(%ZNData,$c(1),%ZTemp+2)
  .. S %ZNCommand=$P($P(%ZNData,":",2,9999),$c(1),1)
  .. S:%ZNCommand[($c(5)_"xmldata=1") %ZNCommand=$p(%ZNCommand,$c(5)_"xmldata=1",1) 
  .. s P9=""
  .. //s:($tr(%ZNCommand," ")'="")&(%ZNData'["getsessionid=1") %ZNCommand=$$GetFunc(%ZNCommand)
  .. d:%ZNData'["getsessionid=1" Ex(.%ZNCommand)
  .. i %ZNData'["getsessionid=1" s ^Aaa("com")=%ZNCommand x %ZNCommand
  .. s:%ZNData["getsessionid=1" P0=$JOB
  .. F %ZTemp=0:1:9 S %Var="P"_%ZTemp I '$D(@%Var) S @%Var=""
  .. W "glc_EXRESPONSE:<registry>",value,$C(1),P0,$C(1),P1,$C(1),P2,$C(1),P3,$C(1),P4,$C(1),P5,$C(1),P6,$C(1),P7,$C(1),P8,$C(1),P9,$c(1)
  .. W $c(9,8,7,6,5,4,3,2,1),*-3 
  ..q
  .q
  Q       
Ex(Cmd)  
  q:Cmd=""
  f  q:($e(Cmd)'=" ")!(Cmd="")  s Cmd=$e(Cmd,2,32000)
  q:Cmd=""
  i $e(Cmd)="$" s Cmd="s value="_Cmd q
  i $e(Cmd)="=" s Cmd="s value"_Cmd q
  q