INHVTMT2 ; KAC ; 02 Nov 1999 17:54 ; Multi-threaded TCP/IP socket utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
RECEIVE(INCHNL,INIP,INERR,INMEM) ; Function - Read messages from
; TCP bfr and process into GIS. Once in this routine, reading is
; atomic (the transceiver may be told to stop, but RECEIVE will
; finish to a logical conclusion instead of throwing away data
; in the buffer or INREC).
;
; Called by: INHVTMT
;
; Input:
; INCHNL - (req) Socket from which to read
; INIP - (pbr) Array of parameters
; INERR - (pbr) Error array
; INMEM - not used (placeholder. %INET secondary memory)
;
; Function returns:
; 0=ok
; 1=no response at all
; 2=failure in middle of receive
; 3=remote system disconnected
;
; Note: The check for remote system disconnect is based on a string
; match from utility routine %INET. If that utility is changed, this
; must also be changed.
;
N I,INBFR,INCLRMSG,INDELIM,INDONE,INEOL,INEOM,INFIRST,INFRMPOS,INFS,INIVBLD,INLOGMSG,INMSG,INMSGCNT,INNORESP,INNULLRD,INPOS,INREC,INRECCNT,INRSTATE,INSMIN,INSOD,INSOM,INV,REC,X,Y,Z
;
; Constants
S INEOL=INIP("EOL"),INSOM=INIP("SOM"),INEOM=INIP("EOM")
S:$D(INIP("SOD")) INSOD=INIP("SOD")
S:$D(INIP("FS")) INFS=INIP("FS")
S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
S INDELIM=$$FIELD^INHUT()
;
; Variables
S (INBFR,INIVBLD,INMSG)="",(INDONE,INMSGCNT,INNORESP,INNULLRD,INRECCNT)=0
S INREC="REC" K @INREC
S INRSTATE="SOM" ; looking for SOM
S INFIRST=1 ; 1st time thru decryptor per msg
S INCLRMSG='$G(INIP("CRYPT")) ; 1 = do not decrypt rcv'd msg
;
; Main Loop
F D Q:INDONE!INNORESP ; til no response or disconnect
. D:$G(INDEBUG) LOG^INHVCRA1("Reading from buffer.",5)
.; read input bfr (up to 512 bytes)
. D RECV^%INET(.INBFR,.INCHNL,INIP("RTO"),1)
.;
.; Disconnect
. I $G(INBFR(0))["Remote end disconnect" D Q
.. S INDISCNT=INDISCNT+1
.. I INIP("DTRY")'>INDISCNT D Q ; shutdwn xceiver
... S INRUNMT=0,INDONE=1
... S INLOGMSG="Disconnect retries exceeded for background process "_INBPNM
... D:$G(INDEBUG) LOG^INHVCRA1(INLOGMSG,7)
... D ENR^INHE(INBPN,INLOGMSG)
.. S INDONE=3 ; retries not exceeded
.;
.; No response (on 1st or subsequent reads, therefore a 1 or 2 error)
.; Read retries prevent dropping 1st part of msg cos 2nd part was delayed
. I INBFR="" D Q
..; stop reading if not expecting any responses
..; pend que empty, not expecting HB response, not in middle of building msg
.. I '$D(^INLHDEST(INDSTR,"PEND",INBPN)),(INSTATE'="HB"),'INRECCNT,'$D(INRSTATE("SOMFRAG")) S INPEND=0,INDONE=1 Q
.. S INNULLRD=INNULLRD+1
.. I INIP("RTRY")'>INNULLRD S INNORESP=1 Q ; read tries exceeded
.. D WAIT^INHUVUT2(INBPN,INIP("RHNG"),"Waiting "_INIP("RHNG")_" seconds to read buffer",.INRUNMT)
.. S INRUNMT='INRUNMT ; wait rtns opposite
..; if signalled to stop xceiver, stop if not in middle of building msg
.. I 'INRUNMT,'INRECCNT,'$D(INRSTATE("SOMFRAG")) S INDONE=1 Q
. S (INNULLRD,INDISCNT)=0 ; reset upon receipt
.;
.; Ck for bfr continuation (SOM frags). If no frags found, continue
.; search for current state in this new bfr.
. I $D(INRSTATE("SOMFRAG")) D ; SOM frags exist from prev read
.. S X=$L(INSOM)-$L(INRSTATE("SOMFRAG")) ; # SOM chars expected @ start of in this bfr
.. I (INRSTATE("SOMFRAG")_$E(INBFR,1,X)=INSOM) D
...; found frag completion at start of new bfr
... D:$G(INRECCNT) DATAFRAG^INHVTMT3(@INREC@(INRECCNT),0,$L(@INREC@(INRECCNT))) ; log msg in progress as data frag
... S INBFR=$E(INBFR,X+1,999999) ; remove SOM from msg
... S INRSTATE="SOD" ; SOM found - look for SOD
.. K INRSTATE("SOMFRAG")
.;
.; create array (INFRMPOS) of framing chars in this bfr subscripted by position
. K INFRMPOS
. D GETFRAME^INHVTMT3(INBFR,INSOM,.INFRMPOS)
. D:$D(INSOD) GETFRAME^INHVTMT3(INBFR,INSOD,.INFRMPOS)
. D GETFRAME^INHVTMT3(INBFR,INEOM,.INFRMPOS)
.;
. S INPOS=0,INPOS("PREV")=0 ; must be remembered while reading bfr
.;
. F D Q:'INPOS ; scan for multiple msgs til bfr exhausted
..;
..; Scan bfr for single msg (or portion of msg)
.. F I="SOM","SOD","EOM" S INPOS(I)=0
.. F S INPOS=$O(INFRMPOS(INPOS)) Q:'INPOS D Q:INPOS("EOM")
... I (INRSTATE="SOM"),(INFRMPOS(INPOS)=INSOM) D Q
.... S INPOS("SOM")=INPOS
.... S INRSTATE=$S($D(INSOD):"SOD",1:"EOM") ; SOD may not be used
... I $D(INSOD),(INRSTATE="SOD"),(INFRMPOS(INPOS)=INSOD) D Q
.... S INPOS("SOD")=INPOS
.... S INRSTATE="EOM"
... I (INRSTATE="EOM"),(INFRMPOS(INPOS)=INEOM) D Q
.... S INPOS("EOM")=INPOS
.... S INRSTATE="SOM"
....; last position this bfr after which to log data frags
.... S INPOS("PREV")=INPOS
...;
...; Data Fragmentation (possibly across bfrs)
... D DATAFRAG^INHVTMT3(INBFR,INPOS("PREV")+1,INPOS)
... S INPOS("PREV")=INPOS
...; incorrectly placed SOM may be start of good msg
... I INFRMPOS(INPOS)=INSOM D Q
.... S INPOS("SOM")=INPOS
.... S INRSTATE=$S($D(INSOD):"SOD",1:"EOM") ; SOD may not be used
...;
..; Scanning complete - ck for bfr continuation or SOM fragments
..; Scan returns incomplete msg
.. I 'INPOS D Q ; reached end of bfr during scan before finding complete msg
...; SOM frags @ end of bfr?
... I $L(INSOM)>1,($E(INBFR,$L(INBFR)-$L(INSOM)+1,$L(INBFR))'=INSOM) D
.... S X=$L(INBFR)+1,Y=$L(INSOM)-1
.... F I=1:1:Y S Z=$E(INBFR,X-I,$L(INBFR)) I Z=$E(INSOM,1,I) S INRSTATE("SOMFRAG")=Z Q ; save frags
...;
... I "^SOD^EOM^"[(U_INRSTATE_U) D Q ; bfr continuation
.... S INMSG=$E(INBFR,INPOS("SOM"),$L(INBFR))
.... D PUTINREC^INHVTMT3(INMSG)
...;
...; If looking for SOM, log data frag (if any) thru end of bfr
... I (INRSTATE="SOM") D Q
.... S X=INPOS("PREV"),Y=$L(INBFR)-$L($G(INRSTATE("SOMFRAG")))
.... D:((Y-X)>0) DATAFRAG^INHVTMT3(INBFR,INPOS("PREV")+1,Y)
..;
..; Scan returns complete msg (EOM found)
.. I INPOS D
... I $G(INRECCNT) D ; multiple-bfrs of data in INREC
.... S INMSG=$E(INBFR,1,INPOS("EOM"))
.... D PUTINREC^INHVTMT3(INMSG)
... I '$G(INRECCNT) D ; msg all in 1 bfr (includes SOM frags - $E expects INPOS("SOM")=0)
.... S INMSG=$E(INBFR,INPOS("SOM"),INPOS("EOM"))
.... D PUTINREC^INHVTMT3(INMSG)
..;
.. Q:'INRECCNT ; no complete, raw msg to parse/validate
..;
..; Process msg @INREC
.. S INV="INDATA" K @INV
.. D PARSE^INHUVUT1 ; put INREC into INV
.. K @INREC S INREC="REC",INRECCNT=0
.. D EVAL^INHVTMT3(INV) ; submit msg for validation
.. K @INV
.. S INMSGCNT=INMSGCNT+1 ; # msgs read since call to $$RECEIVE
;
;
; Finished reading - return final state of connection
;
; Remote end disconnected
I INDONE=3 S INERR=$G(INBFR(0)) K @INREC Q 3
;
; Remote system timed-out / log error
I INRECCNT,INNORESP D Q 2
. S INERR="Remote system on "_INBPNM_" timed out during transmission of message"
. D DATAFRAG^INHVTMT3($G(@INREC@(1)),0,$L($G(@INREC@(1)))) ; log msg in progress as data frag
;
; No message received
I 'INMSGCNT,INNORESP S INERR="No message received from remote system on transceiver "_INBPNM K @INREC Q 1
;
Q 0
;
;
INHVTMT2 ; KAC ; 02 Nov 1999 17:54 ; Multi-threaded TCP/IP socket utilities
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
RECEIVE(INCHNL,INIP,INERR,INMEM) ; Function - Read messages from
+1 ; TCP bfr and process into GIS. Once in this routine, reading is
+2 ; atomic (the transceiver may be told to stop, but RECEIVE will
+3 ; finish to a logical conclusion instead of throwing away data
+4 ; in the buffer or INREC).
+5 ;
+6 ; Called by: INHVTMT
+7 ;
+8 ; Input:
+9 ; INCHNL - (req) Socket from which to read
+10 ; INIP - (pbr) Array of parameters
+11 ; INERR - (pbr) Error array
+12 ; INMEM - not used (placeholder. %INET secondary memory)
+13 ;
+14 ; Function returns:
+15 ; 0=ok
+16 ; 1=no response at all
+17 ; 2=failure in middle of receive
+18 ; 3=remote system disconnected
+19 ;
+20 ; Note: The check for remote system disconnect is based on a string
+21 ; match from utility routine %INET. If that utility is changed, this
+22 ; must also be changed.
+23 ;
+24 NEW I,INBFR,INCLRMSG,INDELIM,INDONE,INEOL,INEOM,INFIRST,INFRMPOS,INFS,INIVBLD,INLOGMSG,INMSG,INMSGCNT,INNORESP,INNULLRD,INPOS,INREC,INRECCNT,INRSTATE,INSMIN,INSOD,INSOM,INV,REC,X,Y,Z
+25 ;
+26 ; Constants
+27 SET INEOL=INIP("EOL")
SET INSOM=INIP("SOM")
SET INEOM=INIP("EOM")
+28 IF $DATA(INIP("SOD"))
SET INSOD=INIP("SOD")
+29 IF $DATA(INIP("FS"))
SET INFS=INIP("FS")
+30 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+31 SET INDELIM=$$FIELD^INHUT()
+32 ;
+33 ; Variables
+34 SET (INBFR,INIVBLD,INMSG)=""
SET (INDONE,INMSGCNT,INNORESP,INNULLRD,INRECCNT)=0
+35 SET INREC="REC"
KILL @INREC
+36 ; looking for SOM
SET INRSTATE="SOM"
+37 ; 1st time thru decryptor per msg
SET INFIRST=1
+38 ; 1 = do not decrypt rcv'd msg
SET INCLRMSG='$GET(INIP("CRYPT"))
+39 ;
+40 ; Main Loop
+41 ; til no response or disconnect
FOR
Begin DoDot:1
+42 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Reading from buffer.",5)
+43 ; read input bfr (up to 512 bytes)
+44 DO RECV^%INET(.INBFR,.INCHNL,INIP("RTO"),1)
+45 ;
+46 ; Disconnect
+47 IF $GET(INBFR(0))["Remote end disconnect"
Begin DoDot:2
+48 SET INDISCNT=INDISCNT+1
+49 ; shutdwn xceiver
IF INIP("DTRY")'>INDISCNT
Begin DoDot:3
+50 SET INRUNMT=0
SET INDONE=1
+51 SET INLOGMSG="Disconnect retries exceeded for background process "_INBPNM
+52 IF $GET(INDEBUG)
DO LOG^INHVCRA1(INLOGMSG,7)
+53 DO ENR^INHE(INBPN,INLOGMSG)
End DoDot:3
QUIT
+54 ; retries not exceeded
SET INDONE=3
End DoDot:2
QUIT
+55 ;
+56 ; No response (on 1st or subsequent reads, therefore a 1 or 2 error)
+57 ; Read retries prevent dropping 1st part of msg cos 2nd part was delayed
+58 IF INBFR=""
Begin DoDot:2
+59 ; stop reading if not expecting any responses
+60 ; pend que empty, not expecting HB response, not in middle of building msg
+61 IF '$DATA(^INLHDEST(INDSTR,"PEND",INBPN))
IF (INSTATE'="HB")
IF 'INRECCNT
IF '$DATA(INRSTATE("SOMFRAG"))
SET INPEND=0
SET INDONE=1
QUIT
+62 SET INNULLRD=INNULLRD+1
+63 ; read tries exceeded
IF INIP("RTRY")'>INNULLRD
SET INNORESP=1
QUIT
+64 DO WAIT^INHUVUT2(INBPN,INIP("RHNG"),"Waiting "_INIP("RHNG")_" seconds to read buffer",.INRUNMT)
+65 ; wait rtns opposite
SET INRUNMT='INRUNMT
+66 ; if signalled to stop xceiver, stop if not in middle of building msg
+67 IF 'INRUNMT
IF 'INRECCNT
IF '$DATA(INRSTATE("SOMFRAG"))
SET INDONE=1
QUIT
End DoDot:2
QUIT
+68 ; reset upon receipt
SET (INNULLRD,INDISCNT)=0
+69 ;
+70 ; Ck for bfr continuation (SOM frags). If no frags found, continue
+71 ; search for current state in this new bfr.
+72 ; SOM frags exist from prev read
IF $DATA(INRSTATE("SOMFRAG"))
Begin DoDot:2
+73 ; # SOM chars expected @ start of in this bfr
SET X=$LENGTH(INSOM)-$LENGTH(INRSTATE("SOMFRAG"))
+74 IF (INRSTATE("SOMFRAG")_$EXTRACT(INBFR,1,X)=INSOM)
Begin DoDot:3
+75 ; found frag completion at start of new bfr
+76 ; log msg in progress as data frag
IF $GET(INRECCNT)
DO DATAFRAG^INHVTMT3(@INREC@(INRECCNT),0,$LENGTH(@INREC@(INRECCNT)))
+77 ; remove SOM from msg
SET INBFR=$EXTRACT(INBFR,X+1,999999)
+78 ; SOM found - look for SOD
SET INRSTATE="SOD"
End DoDot:3
+79 KILL INRSTATE("SOMFRAG")
End DoDot:2
+80 ;
+81 ; create array (INFRMPOS) of framing chars in this bfr subscripted by position
+82 KILL INFRMPOS
+83 DO GETFRAME^INHVTMT3(INBFR,INSOM,.INFRMPOS)
+84 IF $DATA(INSOD)
DO GETFRAME^INHVTMT3(INBFR,INSOD,.INFRMPOS)
+85 DO GETFRAME^INHVTMT3(INBFR,INEOM,.INFRMPOS)
+86 ;
+87 ; must be remembered while reading bfr
SET INPOS=0
SET INPOS("PREV")=0
+88 ;
+89 ; scan for multiple msgs til bfr exhausted
FOR
Begin DoDot:2
+90 ;
+91 ; Scan bfr for single msg (or portion of msg)
+92 FOR I="SOM","SOD","EOM"
SET INPOS(I)=0
+93 FOR
SET INPOS=$ORDER(INFRMPOS(INPOS))
IF 'INPOS
QUIT
Begin DoDot:3
+94 IF (INRSTATE="SOM")
IF (INFRMPOS(INPOS)=INSOM)
Begin DoDot:4
+95 SET INPOS("SOM")=INPOS
+96 ; SOD may not be used
SET INRSTATE=$SELECT($DATA(INSOD):"SOD",1:"EOM")
End DoDot:4
QUIT
+97 IF $DATA(INSOD)
IF (INRSTATE="SOD")
IF (INFRMPOS(INPOS)=INSOD)
Begin DoDot:4
+98 SET INPOS("SOD")=INPOS
+99 SET INRSTATE="EOM"
End DoDot:4
QUIT
+100 IF (INRSTATE="EOM")
IF (INFRMPOS(INPOS)=INEOM)
Begin DoDot:4
+101 SET INPOS("EOM")=INPOS
+102 SET INRSTATE="SOM"
+103 ; last position this bfr after which to log data frags
+104 SET INPOS("PREV")=INPOS
End DoDot:4
QUIT
+105 ;
+106 ; Data Fragmentation (possibly across bfrs)
+107 DO DATAFRAG^INHVTMT3(INBFR,INPOS("PREV")+1,INPOS)
+108 SET INPOS("PREV")=INPOS
+109 ; incorrectly placed SOM may be start of good msg
+110 IF INFRMPOS(INPOS)=INSOM
Begin DoDot:4
+111 SET INPOS("SOM")=INPOS
+112 ; SOD may not be used
SET INRSTATE=$SELECT($DATA(INSOD):"SOD",1:"EOM")
End DoDot:4
QUIT
+113 ;
End DoDot:3
IF INPOS("EOM")
QUIT
+114 ; Scanning complete - ck for bfr continuation or SOM fragments
+115 ; Scan returns incomplete msg
+116 ; reached end of bfr during scan before finding complete msg
IF 'INPOS
Begin DoDot:3
+117 ; SOM frags @ end of bfr?
+118 IF $LENGTH(INSOM)>1
IF ($EXTRACT(INBFR,$LENGTH(INBFR)-$LENGTH(INSOM)+1,$LENGTH(INBFR))'=INSOM)
Begin DoDot:4
+119 SET X=$LENGTH(INBFR)+1
SET Y=$LENGTH(INSOM)-1
+120 ; save frags
FOR I=1:1:Y
SET Z=$EXTRACT(INBFR,X-I,$LENGTH(INBFR))
IF Z=$EXTRACT(INSOM,1,I)
SET INRSTATE("SOMFRAG")=Z
QUIT
End DoDot:4
+121 ;
+122 ; bfr continuation
IF "^SOD^EOM^"[(U_INRSTATE_U)
Begin DoDot:4
+123 SET INMSG=$EXTRACT(INBFR,INPOS("SOM"),$LENGTH(INBFR))
+124 DO PUTINREC^INHVTMT3(INMSG)
End DoDot:4
QUIT
+125 ;
+126 ; If looking for SOM, log data frag (if any) thru end of bfr
+127 IF (INRSTATE="SOM")
Begin DoDot:4
+128 SET X=INPOS("PREV")
SET Y=$LENGTH(INBFR)-$LENGTH($GET(INRSTATE("SOMFRAG")))
+129 IF ((Y-X)>0)
DO DATAFRAG^INHVTMT3(INBFR,INPOS("PREV")+1,Y)
End DoDot:4
QUIT
End DoDot:3
QUIT
+130 ;
+131 ; Scan returns complete msg (EOM found)
+132 IF INPOS
Begin DoDot:3
+133 ; multiple-bfrs of data in INREC
IF $GET(INRECCNT)
Begin DoDot:4
+134 SET INMSG=$EXTRACT(INBFR,1,INPOS("EOM"))
+135 DO PUTINREC^INHVTMT3(INMSG)
End DoDot:4
+136 ; msg all in 1 bfr (includes SOM frags - $E expects INPOS("SOM")=0)
IF '$GET(INRECCNT)
Begin DoDot:4
+137 SET INMSG=$EXTRACT(INBFR,INPOS("SOM"),INPOS("EOM"))
+138 DO PUTINREC^INHVTMT3(INMSG)
End DoDot:4
End DoDot:3
+139 ;
+140 ; no complete, raw msg to parse/validate
IF 'INRECCNT
QUIT
+141 ;
+142 ; Process msg @INREC
+143 SET INV="INDATA"
KILL @INV
+144 ; put INREC into INV
DO PARSE^INHUVUT1
+145 KILL @INREC
SET INREC="REC"
SET INRECCNT=0
+146 ; submit msg for validation
DO EVAL^INHVTMT3(INV)
+147 KILL @INV
+148 ; # msgs read since call to $$RECEIVE
SET INMSGCNT=INMSGCNT+1
End DoDot:2
IF 'INPOS
QUIT
End DoDot:1
IF INDONE!INNORESP
QUIT
+149 ;
+150 ;
+151 ; Finished reading - return final state of connection
+152 ;
+153 ; Remote end disconnected
+154 IF INDONE=3
SET INERR=$GET(INBFR(0))
KILL @INREC
QUIT 3
+155 ;
+156 ; Remote system timed-out / log error
+157 IF INRECCNT
IF INNORESP
Begin DoDot:1
+158 SET INERR="Remote system on "_INBPNM_" timed out during transmission of message"
+159 ; log msg in progress as data frag
DO DATAFRAG^INHVTMT3($GET(@INREC@(1)),0,$LENGTH($GET(@INREC@(1))))
End DoDot:1
QUIT 2
+160 ;
+161 ; No message received
+162 IF 'INMSGCNT
IF INNORESP
SET INERR="No message received from remote system on transceiver "_INBPNM
KILL @INREC
QUIT 1
+163 ;
+164 QUIT 0
+165 ;
+166 ;
