| 1 | TMGKERN2 ;TMG/kst/OS Specific functions ;11/21/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/21/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG KERNEL FUNCTIONS -- 2
|
|---|
| 5 | ;"This module is primarly for functions to support a SOCKET
|
|---|
| 6 | ;" connection between two different VistA instances. One running
|
|---|
| 7 | ;" as a server, and the other as a client.
|
|---|
| 8 | ;"I.e. functions that are OS specific.
|
|---|
| 9 | ;"Kevin Toppenberg MD
|
|---|
| 10 | ;"GNU General Public License (GPL) applies
|
|---|
| 11 | ;"11/21/09
|
|---|
| 12 | ;
|
|---|
| 13 | RUNSERVER(PORT,TMGMSGFN,TMGVERBOSE)
|
|---|
| 14 | ;"Purpose: To open up a socket that will listen to requests from a client.
|
|---|
| 15 | ;"Input: Port -- the port to listen on
|
|---|
| 16 | ;" TMGMSGFN -- the NAME of a function that will handle incoming
|
|---|
| 17 | ;" messages. E.g. 'HANDLMSG^MOD1'
|
|---|
| 18 | ;" This function will be called as follows:
|
|---|
| 19 | ;" xecute "DO "_TMGMSGFN_"(TMGCLIENT)"
|
|---|
| 20 | ;" So the function must accept at least 1 parameter.
|
|---|
| 21 | ;" TMGVERBOSE -- If 1 then some output will be show to console.
|
|---|
| 22 | ;"Results: 1 if successful, -1^Error Message if failed.
|
|---|
| 23 | ;"NOTE: This will be messaging protocol.
|
|---|
| 24 | ;" #HELLO# will be sent on startup (possibly preceeded by 2 blank lines)
|
|---|
| 25 | ;" #BYE# will be sent when server is quitting
|
|---|
| 26 | ;" Server will respond to query of #BYE# by quitting.
|
|---|
| 27 | ;" Server will turn control over to the message-handler-fn, allowing it to write
|
|---|
| 28 | ;" out as many lines as it wants.
|
|---|
| 29 | ;" After message-handler-fn returns, the server will send #OK# to signal done.
|
|---|
| 30 | ;"
|
|---|
| 31 | NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
|
|---|
| 32 | NEW TMGCLIENT,TMGANSWR,TMGCODE
|
|---|
| 33 | ;
|
|---|
| 34 | SET RESULT=1 ;"Default of success
|
|---|
| 35 | IF +$GET(PORT)'>0 DO GOTO RSVRDN
|
|---|
| 36 | . SET RESULT="-1^Invalid port number passed. Received: "_$GET(PORT)
|
|---|
| 37 | IF $GET(TMGMSGFN)="" DO GOTO RSVRDN
|
|---|
| 38 | . SET RESULT="-1^No Message handling function passed."
|
|---|
| 39 | IF $TEXT(@TMGMSGFN)="" DO GOTO RSVRDN
|
|---|
| 40 | . SET RESULT="-1^Message handler ["_TMGMSGFN_"] appears invalid"
|
|---|
| 41 | SET PORT=+$GET(PORT)
|
|---|
| 42 | SET TMGDELIM=$CHAR(13)
|
|---|
| 43 | SET TMGTCPDEV="server$"_$JOB
|
|---|
| 44 | SET TMGTIMEOUT=30
|
|---|
| 45 | SET TMGCODE="DO "_TMGMSGFN_"(TMGCLIENT)"
|
|---|
| 46 | SET TMGVERBOSE=+$GET(TMGVERBOSE)
|
|---|
| 47 | ;
|
|---|
| 48 | OPEN TMGTCPDEV:(ZLISTEN=PORT_":TCP":attach="server":DELIMITER=TMGDELIM):TMGTIMEOUT:"SOCKET"
|
|---|
| 49 | IF $TEST=0 DO goto RSVRDN
|
|---|
| 50 | . SET RESULT="-1^Attempts to open server failed (timedout)"
|
|---|
| 51 | USE TMGTCPDEV
|
|---|
| 52 | WRITE /listen(1)
|
|---|
| 53 | WRITE /wait(TMGTIMEOUT)
|
|---|
| 54 | WRITE "#HELLO#",!
|
|---|
| 55 | ;
|
|---|
| 56 | L1 ;"Main Listen-Reply loop
|
|---|
| 57 | NEW TMGCLIENT,TMGI,TMGDONE
|
|---|
| 58 | SET TMGDONE=-1,TMGI=1
|
|---|
| 59 | FOR DO QUIT:(TMGDONE>0)!(TMGI>100)!(TMGCLIENT="#BYE#")
|
|---|
| 60 | . USE TMGTCPDEV
|
|---|
| 61 | . READ TMGCLIENT:TMGTIMEOUT
|
|---|
| 62 | . IF ($TEST=0)!(TMGCLIENT="") DO QUIT
|
|---|
| 63 | . . SET TMGDONE=TMGDONE+1
|
|---|
| 64 | . . WRITE "#BYE#",!
|
|---|
| 65 | . IF TMGCLIENT="#ENQ#" WRITE "#ACK#",! QUIT
|
|---|
| 66 | . IF TMGCLIENT="#BYE#" WRITE "#BYE#",! QUIT
|
|---|
| 67 | . SET TMGI=TMGI+1
|
|---|
| 68 | . DO
|
|---|
| 69 | . . NEW $etrap
|
|---|
| 70 | . . SET $etrap="write ""<Error in message handler>"",!,$ZSTATUS,! set $etrap="""",$ecode="""""
|
|---|
| 71 | . . XECUTE TMGCODE
|
|---|
| 72 | . USE TMGTCPDEV ;"Ensure handler didn't redirect $IO
|
|---|
| 73 | . WRITE "#OK#",! ;"Send message to indicate done sending reply (will allow multi line responses)
|
|---|
| 74 | . use $P
|
|---|
| 75 | . read *TMGDONE:0
|
|---|
| 76 | . IF TMGVERBOSE DO
|
|---|
| 77 | . . if TMGI#10=1 write "+"
|
|---|
| 78 | . . else write "."
|
|---|
| 79 | ;
|
|---|
| 80 | CLOSE TMGTCPDEV
|
|---|
| 81 | ;
|
|---|
| 82 | RSVRDN USE $P
|
|---|
| 83 | QUIT RESULT
|
|---|
| 84 | ;
|
|---|
| 85 | ;
|
|---|
| 86 | RUNCLIENT(HOST,PORT) ;"NOTE: meant to be run as a background process
|
|---|
| 87 | ;"Purpose: Establish a connection with specified server. Then maintain connection,
|
|---|
| 88 | ;" sending queries to server, and returning results. Will take as input
|
|---|
| 89 | ;" a messaging global ^TMG("TMP","TCP",$J,"TS",<index>)=<query> TS=ToServer
|
|---|
| 90 | ;" And replies will be stored in ^TMG("TMP","TCP",$J,"FS",<index>)=<query> FS=FromServer
|
|---|
| 91 | ;"Input: HOST -- the IP address, (or name for DNS lookup) of the server.
|
|---|
| 92 | ;" PORT -- the port that the server is listening on.
|
|---|
| 93 | ;"Result: none
|
|---|
| 94 | ;"Output: Results will be stored in ^TMG("TMP","TCP",$J,"RESULT")=<result>
|
|---|
| 95 | ;" 1 -- if successful, -1^Error Message if failed.
|
|---|
| 96 | ;"
|
|---|
| 97 | NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
|
|---|
| 98 | ;"Setup vars
|
|---|
| 99 | SET TMGTCPDEV="client$"_$JOB
|
|---|
| 100 | SET TMGTIMEOUT=30
|
|---|
| 101 | KILL ^TMG("TMP","TCP",$J,"RESULT")
|
|---|
| 102 | SET RESULT=1
|
|---|
| 103 | ;"Validate input
|
|---|
| 104 | IF +$GET(PORT)'>0 DO GOTO RCLDN
|
|---|
| 105 | . SET RESULT="-1^Valid port number passed. Received: "_$GET(PORT)
|
|---|
| 106 | IF $GET(HOST)="" DO GOTO RCLDN
|
|---|
| 107 | . SET RESULT="-1^No Host passed."
|
|---|
| 108 | SET PORT=+$GET(PORT)
|
|---|
| 109 | IF PORT'>0 DO GOTO RCLDN
|
|---|
| 110 | . SET RESULT="-1^Invalid port: ["_PORT_"]"
|
|---|
| 111 | ;"Open up the TCP/IP connection
|
|---|
| 112 | OPEN TMGTCPDEV:(CONNECT=HOST_":"_PORT_":TCP":ATTACH="client":DELIMITER=$CHAR(13)):TMGTIMEOUT:"SOCKET"
|
|---|
| 113 | IF $TEST=0 DO GOTO RCLDN
|
|---|
| 114 | . SET RESULT="-1^Error on OPEN of SOCKET"
|
|---|
| 115 | USE TMGTCPDEV
|
|---|
| 116 | ;"Make sure server is ready to send information.
|
|---|
| 117 | NEW TMGI,SRVREPLY
|
|---|
| 118 | FOR TMGI=1:1:3 DO QUIT:(SRVREPLY="#HELLO#")
|
|---|
| 119 | . READ SRVREPLY:TMGTIMEOUT
|
|---|
| 120 | IF SRVREPLY'="#HELLO#" DO GOTO RCLDN
|
|---|
| 121 | . SET RESULT="-1^Failed to get a '#HELLO#' from server"
|
|---|
| 122 | SET ^TMG("TMP","TCP",$J,"RESULT")=$GET(RESULT)
|
|---|
| 123 | ;
|
|---|
| 124 | ;"Now process messaging.
|
|---|
| 125 | RC1 NEW TSREF SET TSREF=$NAME(^TMG("TMP","TCP",$J,"TS"))
|
|---|
| 126 | NEW FSREF SET FSREF=$NAME(^TMG("TMP","TCP",$J,"FS"))
|
|---|
| 127 | NEW QUERY SET QUERY=""
|
|---|
| 128 | NEW TMGIDLE SET TMGIDLE=0
|
|---|
| 129 | FOR DO quit:(QUERY="#BYE#")!(SRVREPLY="#BYE#")
|
|---|
| 130 | . SET TMGI=$ORDER(@TSREF@(""))
|
|---|
| 131 | . IF TMGI="" DO ;"Start idle handling
|
|---|
| 132 | . . SET QUERY=""
|
|---|
| 133 | . . SET TMGIDLE=TMGIDLE+1
|
|---|
| 134 | . . HANG 0.1
|
|---|
| 135 | . . IF TMGIDLE<50 QUIT
|
|---|
| 136 | . . SET QUERY="#ENQ#" ;"send an ENQ every 5 seconds of idleness.
|
|---|
| 137 | . . SET TMGIDLE=0
|
|---|
| 138 | . ELSE DO
|
|---|
| 139 | . . SET QUERY=$get(@TSREF@(TMGI))
|
|---|
| 140 | . . KILL @TSREF@(TMGI)
|
|---|
| 141 | . . SET TMGIDLE=0 ;"Reset idle counter
|
|---|
| 142 | . IF QUERY="" QUIT
|
|---|
| 143 | . USE TMGTCPDEV
|
|---|
| 144 | . WRITE QUERY,! ;"send query to server.
|
|---|
| 145 | . FOR DO QUIT:(SRVREPLY="#BYE#")!(SRVREPLY="#OK#")!(SRVREPLY="#ACK#")
|
|---|
| 146 | . . READ SRVREPLY:TMGTIMEOUT ;"read reply.
|
|---|
| 147 | . . IF ($TEST=0)!(SRVREPLY="") SET SRVREPLY="#BYE#"
|
|---|
| 148 | . . IF SRVREPLY="#ACK#" QUIT ;"Don't record ENQ-ACK's
|
|---|
| 149 | . . IF SRVREPLY="#BYE#" QUIT ;"Don't record Termination signal.
|
|---|
| 150 | . . SET TMGI=+$ORDER(@FSREF@(""),-1)
|
|---|
| 151 | . . SET @FSREF@(TMGI+1)=SRVREPLY
|
|---|
| 152 | WRITE "#BYE#",!
|
|---|
| 153 | CLOSE TMGTCPDEV
|
|---|
| 154 | ;
|
|---|
| 155 | RCLDN USE $P
|
|---|
| 156 | SET ^TMG("TMP","TCP",$J,"RESULT")=$GET(RESULT)
|
|---|
| 157 | HALT
|
|---|
| 158 | ;
|
|---|
| 159 | ;
|
|---|
| 160 | MSGCLIENT(JNUM,QUERY,REPLY,ERROR,TIMEOUT)
|
|---|
| 161 | ;"Purpose: To send messages to background client. So this will be one function
|
|---|
| 162 | ;" that the programmer may interact with. The reason for having the client
|
|---|
| 163 | ;" run as a separate job is so that the server and the client can talk back
|
|---|
| 164 | ;" and forth with ENQ<-->ACK upon either timing out, to keep the connection
|
|---|
| 165 | ;" alive.
|
|---|
| 166 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 167 | ;" QUERY -- The message to send to the server.
|
|---|
| 168 | ;" REPLY -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
|
|---|
| 169 | ;" REPLY(1)=<a reply line from server>
|
|---|
| 170 | ;" REPLY(2)=<a reply line from server>
|
|---|
| 171 | ;" REPLY(3)=<a reply line from server>
|
|---|
| 172 | ;" ERROR -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
|
|---|
| 173 | ;" If error, filled with -1^Message.
|
|---|
| 174 | ;" TIMEOUT -- OPTIONAL. Default=1 (in seconds)
|
|---|
| 175 | ;"Result: none
|
|---|
| 176 | ;
|
|---|
| 177 | KILL ERROR,REPLY
|
|---|
| 178 | NEW RESULT SET RESULT=""
|
|---|
| 179 | SET JNUM=+$GET(JNUM)
|
|---|
| 180 | IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO MSGDN
|
|---|
| 181 | SET QUERY=$GET(QUERY)
|
|---|
| 182 | IF QUERY="" SET ERROR="-1^NO QUERY PROVIDED" GOTO MSGDN
|
|---|
| 183 | SET TIMEOUT=+$GET(TIMEOUT,1)
|
|---|
| 184 | NEW NTIME,STIME SET STIME=$PIECE($H,",",2)
|
|---|
| 185 | NEW TMGI SET TMGI=+$ORDER(^TMG("TMP","TCP",JNUM,"TS",""),-1)
|
|---|
| 186 | SET ^TMG("TMP","TCP",JNUM,"TS",TMGI+1)=QUERY
|
|---|
| 187 | IF QUERY="#BYE#" GOTO MSGDN
|
|---|
| 188 | NEW REPLYI SET REPLYI=1
|
|---|
| 189 | NEW ONELINE SET ONELINE=""
|
|---|
| 190 | FOR DO QUIT:(ONELINE="#OK#")
|
|---|
| 191 | . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
|
|---|
| 192 | . IF TMGI="" DO QUIT
|
|---|
| 193 | . . SET NTIME=$PIECE($H,",",2)
|
|---|
| 194 | . . IF (NTIME-STIME)'<TIMEOUT DO
|
|---|
| 195 | . . . SET ERROR="-1^TIMED OUT WAITING FOR CLIENT TO GET REPLY FROM SERVER"
|
|---|
| 196 | . . . SET ONELINE="#OK#"
|
|---|
| 197 | . SET ONELINE=$GET(^TMG("TMP","TCP",JNUM,"FS",TMGI))
|
|---|
| 198 | . IF ONELINE'="#OK#" SET REPLY(REPLYI)=ONELINE
|
|---|
| 199 | . SET REPLYI=REPLYI+1
|
|---|
| 200 | . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
|
|---|
| 201 | MSGDN QUIT
|
|---|
| 202 | ;
|
|---|
| 203 | ;
|
|---|
| 204 | CLEARBUF(JNUM,ERROR)
|
|---|
| 205 | ;"Purpose: To remove all messages from message buffer.
|
|---|
| 206 | ;"Input: JNUM -- The job number of the background client process
|
|---|
| 207 | ;" ERROR -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
|
|---|
| 208 | ;" If error, filled with -1^Message.
|
|---|
| 209 | ;"Result: None
|
|---|
| 210 | ;
|
|---|
| 211 | KILL ERROR
|
|---|
| 212 | SET JNUM=+$GET(JNUM)
|
|---|
| 213 | IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO CLBFDN
|
|---|
| 214 | NEW TMGI
|
|---|
| 215 | FOR DO QUIT:(TMGI="")
|
|---|
| 216 | . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"TS",""))
|
|---|
| 217 | . IF TMGI="" QUIT
|
|---|
| 218 | . KILL ^TMG("TMP","TCP",JNUM,"TS",TMGI)
|
|---|
| 219 | FOR DO QUIT:(TMGI="")
|
|---|
| 220 | . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
|
|---|
| 221 | . IF TMGI="" QUIT
|
|---|
| 222 | . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
|
|---|
| 223 | ;
|
|---|
| 224 | CLBFDN QUIT
|
|---|
| 225 | ;
|
|---|
| 226 | ;
|
|---|
| 227 | ;"===================================================================
|
|---|
| 228 | ;"===================================================================
|
|---|
| 229 | ;" Delete later...
|
|---|
| 230 | ;"===================================================================
|
|---|
| 231 | ;"===================================================================
|
|---|
| 232 | ;
|
|---|
| 233 | HANDLMSG(MESSAGE)
|
|---|
| 234 | write "Got: ["_MESSAGE_"]. Server is $JOB="_$J,!
|
|---|
| 235 | quit
|
|---|
| 236 | ;
|
|---|
| 237 | ;
|
|---|
