TMGKERN2 ;TMG/kst/OS Specific functions ;11/21/09
         ;;1.0;TMG-LIB;**1**;11/21/09
 ;
 ;"TMG KERNEL FUNCTIONS -- 2
 ;"This module is primarly for functions to support a SOCKET
 ;"    connection between two different VistA instances.  One running
 ;"    as a server, and the other as a client.
 ;"I.e. functions that are OS specific.
 ;"Kevin Toppenberg MD
 ;"GNU General Public License (GPL) applies
 ;"11/21/09
 ;
RUNSERVER(PORT,TMGMSGFN,TMGVERBOSE)
        ;"Purpose:  To open up a socket that will listen to requests from a client.
        ;"Input:  Port -- the port to listen on
        ;"        TMGMSGFN -- the NAME of a function that will handle incoming
        ;"                    messages.  E.g.  'HANDLMSG^MOD1'
        ;"                    This function will be called as follows:
        ;"                    xecute "DO "_TMGMSGFN_"(TMGCLIENT)"
        ;"                    So the function must accept at least 1 parameter.
        ;"        TMGVERBOSE -- If 1 then some output will be show to console.
        ;"Results: 1 if successful, -1^Error Message if failed.
        ;"NOTE:  This will be messaging protocol.
        ;"   #HELLO# will be sent on startup (possibly preceeded by 2 blank lines)
        ;"   #BYE# will be sent when server is quitting
        ;"   Server will respond to query of #BYE# by quitting.
        ;"   Server will turn control over to the message-handler-fn, allowing it to write
        ;"      out as many lines as it wants.
        ;"   After message-handler-fn returns, the server will send #OK# to signal done.
        ;"
        NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
        NEW TMGCLIENT,TMGANSWR,TMGCODE
        ;
        SET RESULT=1 ;"Default of success
        IF +$GET(PORT)'>0 DO  GOTO RSVRDN
        . SET RESULT="-1^Invalid port number passed. Received: "_$GET(PORT)
        IF $GET(TMGMSGFN)="" DO  GOTO RSVRDN
        . SET RESULT="-1^No Message handling function passed."
        IF $TEXT(@TMGMSGFN)="" DO  GOTO RSVRDN
        . SET RESULT="-1^Message handler ["_TMGMSGFN_"] appears invalid"
        SET PORT=+$GET(PORT)
        SET TMGDELIM=$CHAR(13)
        SET TMGTCPDEV="server$"_$JOB
        SET TMGTIMEOUT=30
        SET TMGCODE="DO "_TMGMSGFN_"(TMGCLIENT)"
        SET TMGVERBOSE=+$GET(TMGVERBOSE)
        ;
        OPEN TMGTCPDEV:(ZLISTEN=PORT_":TCP":attach="server":DELIMITER=TMGDELIM):TMGTIMEOUT:"SOCKET"
        IF $TEST=0 DO  goto RSVRDN
        . SET RESULT="-1^Attempts to open server failed (timedout)"
        USE TMGTCPDEV
        WRITE /listen(1)
        WRITE /wait(TMGTIMEOUT)
        WRITE "#HELLO#",!
        ;
L1      ;"Main Listen-Reply loop
        NEW TMGCLIENT,TMGI,TMGDONE
        SET TMGDONE=-1,TMGI=1
        FOR  DO  QUIT:(TMGDONE>0)!(TMGI>100)!(TMGCLIENT="#BYE#")
        . USE TMGTCPDEV
        . READ TMGCLIENT:TMGTIMEOUT
        . IF ($TEST=0)!(TMGCLIENT="") DO  QUIT
        . . SET TMGDONE=TMGDONE+1
        . . WRITE "#BYE#",!
        . IF TMGCLIENT="#ENQ#" WRITE "#ACK#",! QUIT
        . IF TMGCLIENT="#BYE#" WRITE "#BYE#",! QUIT
        . SET TMGI=TMGI+1
        . DO
        . . NEW $etrap
        . . SET $etrap="write ""<Error in message handler>"",!,$ZSTATUS,! set $etrap="""",$ecode="""""
        . . XECUTE TMGCODE
        . USE TMGTCPDEV    ;"Ensure handler didn't redirect $IO
        . WRITE "#OK#",!   ;"Send message to indicate done sending reply (will allow multi line responses)
        . use $P
        . read *TMGDONE:0
        . IF TMGVERBOSE DO
        . . if TMGI#10=1 write "+"
        . . else  write "."
        ;
        CLOSE TMGTCPDEV
        ;
RSVRDN  USE $P
        QUIT RESULT
 ;
 ;
RUNCLIENT(HOST,PORT) ;"NOTE: meant to be run as a background process
        ;"Purpose: Establish a connection with specified server.  Then maintain connection,
        ;"         sending queries to server, and returning results.  Will take as input
        ;"         a messaging global ^TMG("TMP","TCP",$J,"TS",<index>)=<query>    TS=ToServer
        ;"         And replies will be stored in ^TMG("TMP","TCP",$J,"FS",<index>)=<query>  FS=FromServer
        ;"Input: HOST -- the IP address, (or name for DNS lookup) of the server.
        ;"       PORT -- the port that the server is listening on.
        ;"Result: none
        ;"Output: Results will be stored in ^TMG("TMP","TCP",$J,"RESULT")=<result>
        ;"              1 -- if successful, -1^Error Message if failed.
        ;"
        NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
        ;"Setup vars
        SET TMGTCPDEV="client$"_$JOB
        SET TMGTIMEOUT=30
        KILL ^TMG("TMP","TCP",$J,"RESULT")
        SET RESULT=1
        ;"Validate input
        IF +$GET(PORT)'>0 DO  GOTO RCLDN
        . SET RESULT="-1^Valid port number passed. Received: "_$GET(PORT)
        IF $GET(HOST)="" DO  GOTO RCLDN
        . SET RESULT="-1^No Host passed."
        SET PORT=+$GET(PORT)
        IF PORT'>0 DO  GOTO RCLDN
        . SET RESULT="-1^Invalid port: ["_PORT_"]"
        ;"Open up the TCP/IP connection
        OPEN TMGTCPDEV:(CONNECT=HOST_":"_PORT_":TCP":ATTACH="client":DELIMITER=$CHAR(13)):TMGTIMEOUT:"SOCKET"
        IF $TEST=0 DO  GOTO RCLDN
        . SET RESULT="-1^Error on OPEN of SOCKET"
        USE TMGTCPDEV
        ;"Make sure server is ready to send information.
        NEW TMGI,SRVREPLY
        FOR TMGI=1:1:3 DO  QUIT:(SRVREPLY="#HELLO#")
        . READ SRVREPLY:TMGTIMEOUT
        IF SRVREPLY'="#HELLO#" DO  GOTO RCLDN
        . SET RESULT="-1^Failed to get a '#HELLO#' from server"
        SET ^TMG("TMP","TCP",$J,"RESULT")=$GET(RESULT)
        ;
        ;"Now process messaging.
RC1     NEW TSREF SET TSREF=$NAME(^TMG("TMP","TCP",$J,"TS"))
        NEW FSREF SET FSREF=$NAME(^TMG("TMP","TCP",$J,"FS"))
        NEW QUERY SET QUERY=""
        NEW TMGIDLE SET TMGIDLE=0
        FOR  DO  quit:(QUERY="#BYE#")!(SRVREPLY="#BYE#")
        . SET TMGI=$ORDER(@TSREF@(""))
        . IF TMGI="" DO ;"Start idle handling
        . . SET QUERY=""
        . . SET TMGIDLE=TMGIDLE+1
        . . HANG 0.1
        . . IF TMGIDLE<50 QUIT
        . . SET QUERY="#ENQ#"  ;"send an ENQ every 5 seconds of idleness.
        . . SET TMGIDLE=0
        . ELSE  DO
        . . SET QUERY=$get(@TSREF@(TMGI))
        . . KILL @TSREF@(TMGI)
        . . SET TMGIDLE=0  ;"Reset idle counter
        . IF QUERY="" QUIT
        . USE TMGTCPDEV
        . WRITE QUERY,!  ;"send query to server.
        . FOR  DO  QUIT:(SRVREPLY="#BYE#")!(SRVREPLY="#OK#")!(SRVREPLY="#ACK#")
        . . READ SRVREPLY:TMGTIMEOUT ;"read reply.
        . . IF ($TEST=0)!(SRVREPLY="") SET SRVREPLY="#BYE#"
        . . IF SRVREPLY="#ACK#" QUIT ;"Don't record ENQ-ACK's
        . . IF SRVREPLY="#BYE#" QUIT ;"Don't record Termination signal.
        . . SET TMGI=+$ORDER(@FSREF@(""),-1)
        . . SET @FSREF@(TMGI+1)=SRVREPLY
        WRITE "#BYE#",!
        CLOSE TMGTCPDEV
        ;
RCLDN   USE $P
        SET ^TMG("TMP","TCP",$J,"RESULT")=$GET(RESULT)
        HALT
 ;
 ;
MSGCLIENT(JNUM,QUERY,REPLY,ERROR,TIMEOUT)
        ;"Purpose: To send messages to background client.  So this will be one function
        ;"        that the programmer may interact with.  The reason for having the client
        ;"        run as a separate job is so that the server and the client can talk back
        ;"        and forth with ENQ<-->ACK upon either timing out, to keep the connection
        ;"        alive.
        ;"Input: JNUM -- The job number of the background client process
        ;"        QUERY -- The message to send to the server.
        ;"        REPLY -- PASS BY REFERENCE, AN OUT PARAMETER.  Prior data killed.
        ;"                  REPLY(1)=<a reply line from server>
        ;"                  REPLY(2)=<a reply line from server>
        ;"                  REPLY(3)=<a reply line from server>
        ;"        ERROR -- PASS BY REFERENCE, AN OUT PARAMETER.  Prior data killed.
        ;"              If error, filled with -1^Message.
        ;"        TIMEOUT -- OPTIONAL.  Default=1 (in seconds)
        ;"Result: none
        ;
        KILL ERROR,REPLY
        NEW RESULT SET RESULT=""
        SET JNUM=+$GET(JNUM)
        IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO MSGDN
        SET QUERY=$GET(QUERY)
        IF QUERY="" SET ERROR="-1^NO QUERY PROVIDED" GOTO MSGDN
        SET TIMEOUT=+$GET(TIMEOUT,1)
        NEW NTIME,STIME SET STIME=$PIECE($H,",",2)
        NEW TMGI SET TMGI=+$ORDER(^TMG("TMP","TCP",JNUM,"TS",""),-1)
        SET ^TMG("TMP","TCP",JNUM,"TS",TMGI+1)=QUERY
        IF QUERY="#BYE#" GOTO MSGDN
        NEW REPLYI SET REPLYI=1
        NEW ONELINE SET ONELINE=""
        FOR  DO  QUIT:(ONELINE="#OK#")
        . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
        . IF TMGI="" DO  QUIT
        . . SET NTIME=$PIECE($H,",",2)
        . . IF (NTIME-STIME)'<TIMEOUT DO
        . . . SET ERROR="-1^TIMED OUT WAITING FOR CLIENT TO GET REPLY FROM SERVER"
        . . . SET ONELINE="#OK#"
        . SET ONELINE=$GET(^TMG("TMP","TCP",JNUM,"FS",TMGI))
        . IF ONELINE'="#OK#" SET REPLY(REPLYI)=ONELINE
        . SET REPLYI=REPLYI+1
        . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
MSGDN   QUIT
 ;
 ;
CLEARBUF(JNUM,ERROR)
        ;"Purpose: To remove all messages from message buffer.
        ;"Input: JNUM -- The job number of the background client process
        ;"        ERROR -- PASS BY REFERENCE, AN OUT PARAMETER.  Prior data killed.
        ;"              If error, filled with -1^Message.
        ;"Result: None
        ;
        KILL ERROR
        SET JNUM=+$GET(JNUM)
        IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO CLBFDN
        NEW TMGI
        FOR  DO  QUIT:(TMGI="")
        . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"TS",""))
        . IF TMGI="" QUIT
        . KILL ^TMG("TMP","TCP",JNUM,"TS",TMGI)
        FOR  DO  QUIT:(TMGI="")
        . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
        . IF TMGI="" QUIT
        . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
        ;
CLBFDN  QUIT
 ;
 ;
 ;"===================================================================
 ;"===================================================================
  ;"  Delete later...
 ;"===================================================================
 ;"===================================================================
 ;
HANDLMSG(MESSAGE)
        write "Got: ["_MESSAGE_"].  Server is $JOB="_$J,!
        quit
 ;
 ;