- 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 ;
