INETNTC ;cmi/anch/maw - Internet function utility - Cache
;;3.01;BHL IHS Interfaces with GIS;**10,15**;APR 03, 2003
;CHCS TLS_4603; GEN 1; 21-MAY-1999
;COPYRIGHT 1998 SAIC
;NOTE: unlike DSM %INET, this version does NOT support multiple client
; connections to the same address simultaneously by a single process.
;
;IHS/ANMC/HMW Modified for AIX/Cache April & May 2002
Q
OPEN(ZICHAN,ZIX,ZIDOMAIN,ZIPORT,ZIPROT) ;open an internet socket
;input:
; ZICHAN --> receives the "IP Address, domain" or "IP Address"
; ZIX --> variable used as 1st argument to RECV procedure
; ZIDOMAIN --> domain name i.e. Internet address (null to open a server connection.)
; ZIPORT --> port number
; ZIPROT --> null, 0 or 1:tcp, 2:udp
;
N %,INDI,X
;S $ZT="ERR^"_$T(+0) ;IHS/ANMC/HMW Restore after testing
S INDI=$G(IO,$I)
S ZICHAN=0,ZIX(1)="",ZIX(2)=""
S ZIPROT=$G(ZIPROT),ZIPROT=$S('ZIPROT!(ZIPROT=1):"TCP",1:"UDP")
;IHS/ANMC/HMW Begin cache mods
;Cache doesn't use $KEY they way MSM does to define a unique TCP channel
;This cache mod uses the PORT^IP to uniquely define the channel. HMW
I ^%ZOSF("OS")["OpenM" D
. N ZIDEV,ZIPARAM,ZIKEY
. S ZIPARAM=$S(ZIDOMAIN="":"P",1:"M") ;IHS/ANMC/HMW Changed "MA" to "P" mode for server open (Wed 1500)
. S ZIDEV="|TCP|"_ZIPORT
. OPEN ZIDEV:(ZIDOMAIN:ZIPORT:ZIPARAM):5
. Q:'$T
. U ZIDEV
. S ZICHAN=ZIPORT_"^"_ZIDOMAIN
. U:INDI]"" INDI
. Q
Q:^%ZOSF("OS")["OpenM"
;
;IHS/ANMC/HMW End cache mods
C 56 O 56::5
;Xecute statements for ^ZCMS (not proper DSM syntax - duh.)
; :(:1) sets the flag on the TCP port to change the behavior of
; a WRITE ! to the socket - it will transmit <CR><LF> instead of
; merely flushing the buffer. See "MSM-Server User's Guide" in the
; "Using Peripheral Devices" section labeled "TCP/IP Socket Device"
; for more information.
;
X "U 56:(:1)" ; !=$C(13,10)
X "U 56::ZIPROT W /SOCKET(ZIDOMAIN,ZIPORT) S %=$KEY=""""!$ZC" Q:%
X "S ZICHAN=$KEY" ; $KEY is MSM's "connection" (numeric) identifier
U:INDI]"" INDI
Q
;
CLOSE(ZICHAN) ;close the Internet socket (flush)
;input:
; ZICHAN --> "IP Address, domain" or "IP Address"
;
Q:'$L($G(ZICHAN))
;S $ZT="QUIT^"_$T(+0) ;IHS/ANMC/HMW Restore after testing
;IHS/ANMC/HMW Begin cache mods
;
I ^%ZOSF("OS")["OpenM" D
. N ZIDEV,ZIPORT
. S ZIPORT=$P(ZICHAN,"^")
. S ZIDEV="|TCP|"_ZIPORT
. C:ZIPORT ZIDEV
. K ZICHAN
. Q
Q:^%ZOSF("OS")["OpenM"
;
;IHS/ANMC/HMW End cache mods
X "C:ZICHAN 56:ZICHAN" K ZICHAN
Q
;
SEND(ZIX,ZICHAN,ZICRLF) ;send a message over socket
;input:
; ZIX --> a line of text to be sent
; ZICHAN --> "IP Address, Domain" or "IP Address"
; ZICRLF --> carriage return/line feed flag 0:yes, 1:no
;
S $ZT="ERR^"_$T(+0)
;
;IHS/ANMC/HMW Begin cache mods
;N INDI S INDI=$G(IO,$I) U 56 ;IHS/ANMC/HMW Original
N INDI S INDI=$G(IO,$I)
I ^%ZOSF("OS")["OpenM" D
. U "|TCP|"_$P(ZICHAN,"^")
E D
. U 56
;IHS/ANMC/HMW End cache mods
;
I '$G(ZICRLF),$L(ZIX)<511 W ZIX_$C(13,10)
E W ZIX W:'$G(ZICRLF) !
I ^%ZOSF("OS")["OpenM" W *-3 ;IHS/ANMC/HMW Added for cache
U:INDI]"" INDI Q
;
RECV(ZIX,ZICHAN,ZITO,ZICRLF) ;receive message from socket
;input:
; ZIX --> variable/array buffer
; ZICHAN --> "IP Address, Domain" or "IP Address"
; ZITO --> numeric time out valued in seconds
; ZICRLF --> carriage return/line feed flag 0:yes, 1:no
; (YES means we expect a CR LF and wish to strip it before
; returning to calling application.)
;output:
; ZIX --> received message
;
S $ZT="ERR^"_$T(+0)
;IHS/ANMC/HMW Begin cache mods
;N INDI S INDI=$G(IO,$I) U 56 ;IHS/ANMC/HMW Original
N INDI S INDI=$G(IO,$I)
I ^%ZOSF("OS")["OpenM" D
. U "|TCP|"_$P(ZICHAN,"^")
E D
. U 56
;IHS/ANMC/HMW End cache mods
S ZICRLF=$G(ZICRLF) K ZIX(0)
S ZITO=$S('$D(ZITO):600,1:ZITO),ZIX(1)=$G(ZIX(1)),ZIX(2)=$G(ZIX(2))
;
; If a <CR> <LF> is expected as delimiter, and should be stripped...
I 'ZICRLF D U:INDI]"" INDI Q
.;Loop until we either get a terminator or a read timeout
.N INOK S INOK=0,ZIX="" F D Q:$D(ZIX(0))!(INOK)
..S ZIX(2)=ZIX(2)_ZIX
..;If data left in buffer, use that first
..I $L(ZIX(2)),$F(ZIX(2),$C(10)) D S INOK=1 Q
...N Y S Y=$F(ZIX(2),$C(10)),ZIX=$E(ZIX(2),1,Y-($A(ZIX(2),Y-2)=13)-2),ZIX(2)=$E(ZIX(2),Y,$L(ZIX(2)))
...I $L(ZIX)>512 S ZIX(2)=$E(ZIX,513,$L(ZIX))_$C(10)_ZIX(2),ZIX=$E(ZIX,1,512)
..I $L(ZIX(2))>511 S INOK=1,ZIX=$E(ZIX(2),1,512),ZIX(2)=$E(ZIX(2),513,$L(ZIX(2))) Q
..;Read more from socket...
..I ZITO R ZIX:ZITO E S ZIX(0)="Connection timed out",ZIX="" Q
..;I ZITO,$ZC S ZIX(0)="Socket closed: MSM Error $ZB="_$ZB,ZIX="" Q ;IHS/ANMC/HMW Original
..I ^%ZOSF("OS")["MSM",ZITO,$ZC S ZIX(0)="Socket closed: MSM Error $ZB="_$ZB,ZIX="" Q ;IHS/ANMC/HMW Modified for cache
..I ^%ZOSF("OS")["OpenM",ZITO,$ZEOF S ZIX(0)="Socket closed: Cache Error $ZB="_$ZB,ZIX="" Q ;IHS/ANMC/HMW Modified for cache, BUT I don't think $ZEOF works like this. Test.
..I 'ZITO R ZIX S INOK=1 Q
..;and append result to the string we will check on next pass
..S ZIX=ZIX(2)_ZIX,ZIX(2)=""
;
;If we are reading just packets, with no terminators (eg CR LF)
;
;If data left in buffer, use that first
I ZICRLF,$L(ZIX(2)) D U:INDI]"" INDI Q
.S ZIX=$E(ZIX(2),1,512),ZIX(2)=$E(ZIX(2),513,$L(ZIX(2)))
;
;Read more from socket
I ZITO R ZIX:ZITO E S ZIX(0)="Connection timed out",ZIX="" U:INDI]"" INDI Q
I 'ZITO R ZIX
;
S ZIX=ZIX(2)_ZIX,ZIX(2)=""
;
I $L(ZIX)>512 S ZIX(2)=$E(ZIX,513,$L(ZIX)),ZIX=$E(ZIX,1,512)
U:INDI]"" INDI
Q
;
ERR ; Handle error trap
;IHS/ANMC/HMW Begin cache mods
;I $ZE["<DSCON" S ZIX(0)="Remote end disconected" X:$G(ZICHAN) "C 56:ZICHAN S ZICHAN=""""" U:INDI]"" INDI Q ;IHS/ANMC/HMW Original
I ^%ZOSF("OS")["MSM",$ZE["<DSCON" S ZIX(0)="Remote end disconected" X:$G(ZICHAN) "C 56:ZICHAN S ZICHAN=""""" U:INDI]"" INDI Q
I ^%ZOSF("OS")["OpenM",(($ZE["<DSCON")!($ZE["<READ")) D U:INDI]"" INDI Q
. S ZIX(0)="Remote end disconect"
. I $G(ZICHAN) D
. . N ZIDEV,ZIPORT
. . S ZIPORT=$P(ZICHAN,"^")
. . S ZIDEV="|TCP|"_ZIPORT
. . C ZIDEV
. Q
;IHS/ANMC/HMW End cache mods
G ^%ET
QUIT ; Ignore all errors when closing the channel. Just close it.
Q
;
INETNTC ;cmi/anch/maw - Internet function utility - Cache
+1 ;;3.01;BHL IHS Interfaces with GIS;**10,15**;APR 03, 2003
+2 ;CHCS TLS_4603; GEN 1; 21-MAY-1999
+3 ;COPYRIGHT 1998 SAIC
+4 ;NOTE: unlike DSM %INET, this version does NOT support multiple client
+5 ; connections to the same address simultaneously by a single process.
+6 ;
+7 ;IHS/ANMC/HMW Modified for AIX/Cache April & May 2002
+8 QUIT
OPEN(ZICHAN,ZIX,ZIDOMAIN,ZIPORT,ZIPROT) ;open an internet socket
+1 ;input:
+2 ; ZICHAN --> receives the "IP Address, domain" or "IP Address"
+3 ; ZIX --> variable used as 1st argument to RECV procedure
+4 ; ZIDOMAIN --> domain name i.e. Internet address (null to open a server connection.)
+5 ; ZIPORT --> port number
+6 ; ZIPROT --> null, 0 or 1:tcp, 2:udp
+7 ;
+8 NEW %,INDI,X
+9 ;S $ZT="ERR^"_$T(+0) ;IHS/ANMC/HMW Restore after testing
+10 SET INDI=$GET(IO,$IO)
+11 SET ZICHAN=0
SET ZIX(1)=""
SET ZIX(2)=""
+12 SET ZIPROT=$GET(ZIPROT)
SET ZIPROT=$SELECT('ZIPROT!(ZIPROT=1):"TCP",1:"UDP")
+13 ;IHS/ANMC/HMW Begin cache mods
+14 ;Cache doesn't use $KEY they way MSM does to define a unique TCP channel
+15 ;This cache mod uses the PORT^IP to uniquely define the channel. HMW
+16 IF ^%ZOSF("OS")["OpenM"
Begin DoDot:1
+17 NEW ZIDEV,ZIPARAM,ZIKEY
+18 ;IHS/ANMC/HMW Changed "MA" to "P" mode for server open (Wed 1500)
SET ZIPARAM=$SELECT(ZIDOMAIN="":"P",1:"M")
+19 SET ZIDEV="|TCP|"_ZIPORT
+20 OPEN ZIDEV:(ZIDOMAIN:ZIPORT:ZIPARAM):5
+21 IF '$TEST
QUIT
+22 USE ZIDEV
+23 SET ZICHAN=ZIPORT_"^"_ZIDOMAIN
+24 IF INDI]""
USE INDI
+25 QUIT
End DoDot:1
+26 IF ^%ZOSF("OS")["OpenM"
QUIT
+27 ;
+28 ;IHS/ANMC/HMW End cache mods
+29 CLOSE 56
OPEN 56::5
+30 ;Xecute statements for ^ZCMS (not proper DSM syntax - duh.)
+31 ; :(:1) sets the flag on the TCP port to change the behavior of
+32 ; a WRITE ! to the socket - it will transmit <CR><LF> instead of
+33 ; merely flushing the buffer. See "MSM-Server User's Guide" in the
+34 ; "Using Peripheral Devices" section labeled "TCP/IP Socket Device"
+35 ; for more information.
+36 ;
+37 ; !=$C(13,10)
XECUTE "U 56:(:1)"
+38 XECUTE "U 56::ZIPROT W /SOCKET(ZIDOMAIN,ZIPORT) S %=$KEY=""""!$ZC"
IF %
QUIT
+39 ; $KEY is MSM's "connection" (numeric) identifier
XECUTE "S ZICHAN=$KEY"
+40 IF INDI]""
USE INDI
+41 QUIT
+42 ;
CLOSE(ZICHAN) ;close the Internet socket (flush)
+1 ;input:
+2 ; ZICHAN --> "IP Address, domain" or "IP Address"
+3 ;
+4 IF '$LENGTH($GET(ZICHAN))
QUIT
+5 ;S $ZT="QUIT^"_$T(+0) ;IHS/ANMC/HMW Restore after testing
+6 ;IHS/ANMC/HMW Begin cache mods
+7 ;
+8 IF ^%ZOSF("OS")["OpenM"
Begin DoDot:1
+9 NEW ZIDEV,ZIPORT
+10 SET ZIPORT=$PIECE(ZICHAN,"^")
+11 SET ZIDEV="|TCP|"_ZIPORT
+12 IF ZIPORT
CLOSE ZIDEV
+13 KILL ZICHAN
+14 QUIT
End DoDot:1
+15 IF ^%ZOSF("OS")["OpenM"
QUIT
+16 ;
+17 ;IHS/ANMC/HMW End cache mods
+18 XECUTE "C:ZICHAN 56:ZICHAN"
KILL ZICHAN
+19 QUIT
+20 ;
SEND(ZIX,ZICHAN,ZICRLF) ;send a message over socket
+1 ;input:
+2 ; ZIX --> a line of text to be sent
+3 ; ZICHAN --> "IP Address, Domain" or "IP Address"
+4 ; ZICRLF --> carriage return/line feed flag 0:yes, 1:no
+5 ;
+6 SET $ZT="ERR^"_$TEXT(+0)
+7 ;
+8 ;IHS/ANMC/HMW Begin cache mods
+9 ;N INDI S INDI=$G(IO,$I) U 56 ;IHS/ANMC/HMW Original
+10 NEW INDI
SET INDI=$GET(IO,$IO)
+11 IF ^%ZOSF("OS")["OpenM"
Begin DoDot:1
+12 USE "|TCP|"_$PIECE(ZICHAN,"^")
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 USE 56
End DoDot:1
+15 ;IHS/ANMC/HMW End cache mods
+16 ;
+17 IF '$GET(ZICRLF)
IF $LENGTH(ZIX)<511
WRITE ZIX_$CHAR(13,10)
+18 IF '$TEST
WRITE ZIX
IF '$GET(ZICRLF)
WRITE !
+19 ;IHS/ANMC/HMW Added for cache
IF ^%ZOSF("OS")["OpenM"
WRITE *-3
+20 IF INDI]""
USE INDI
QUIT
+21 ;
RECV(ZIX,ZICHAN,ZITO,ZICRLF) ;receive message from socket
+1 ;input:
+2 ; ZIX --> variable/array buffer
+3 ; ZICHAN --> "IP Address, Domain" or "IP Address"
+4 ; ZITO --> numeric time out valued in seconds
+5 ; ZICRLF --> carriage return/line feed flag 0:yes, 1:no
+6 ; (YES means we expect a CR LF and wish to strip it before
+7 ; returning to calling application.)
+8 ;output:
+9 ; ZIX --> received message
+10 ;
+11 SET $ZT="ERR^"_$TEXT(+0)
+12 ;IHS/ANMC/HMW Begin cache mods
+13 ;N INDI S INDI=$G(IO,$I) U 56 ;IHS/ANMC/HMW Original
+14 NEW INDI
SET INDI=$GET(IO,$IO)
+15 IF ^%ZOSF("OS")["OpenM"
Begin DoDot:1
+16 USE "|TCP|"_$PIECE(ZICHAN,"^")
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 USE 56
End DoDot:1
+19 ;IHS/ANMC/HMW End cache mods
+20 SET ZICRLF=$GET(ZICRLF)
KILL ZIX(0)
+21 SET ZITO=$SELECT('$DATA(ZITO):600,1:ZITO)
SET ZIX(1)=$GET(ZIX(1))
SET ZIX(2)=$GET(ZIX(2))
+22 ;
+23 ; If a <CR> <LF> is expected as delimiter, and should be stripped...
+24 IF 'ZICRLF
Begin DoDot:1
+25 ;Loop until we either get a terminator or a read timeout
+26 NEW INOK
SET INOK=0
SET ZIX=""
FOR
Begin DoDot:2
+27 SET ZIX(2)=ZIX(2)_ZIX
+28 ;If data left in buffer, use that first
+29 IF $LENGTH(ZIX(2))
IF $FIND(ZIX(2),$CHAR(10))
Begin DoDot:3
+30 NEW Y
SET Y=$FIND(ZIX(2),$CHAR(10))
SET ZIX=$EXTRACT(ZIX(2),1,Y-($ASCII(ZIX(2),Y-2)=13)-2)
SET ZIX(2)=$EXTRACT(ZIX(2),Y,$LENGTH(ZIX(2)))
+31 IF $LENGTH(ZIX)>512
SET ZIX(2)=$EXTRACT(ZIX,513,$LENGTH(ZIX))_$CHAR(10)_ZIX(2)
SET ZIX=$EXTRACT(ZIX,1,512)
End DoDot:3
SET INOK=1
QUIT
+32 IF $LENGTH(ZIX(2))>511
SET INOK=1
SET ZIX=$EXTRACT(ZIX(2),1,512)
SET ZIX(2)=$EXTRACT(ZIX(2),513,$LENGTH(ZIX(2)))
QUIT
+33 ;Read more from socket...
+34 IF ZITO
READ ZIX:ZITO
IF '$TEST
SET ZIX(0)="Connection timed out"
SET ZIX=""
QUIT
+35 ;I ZITO,$ZC S ZIX(0)="Socket closed: MSM Error $ZB="_$ZB,ZIX="" Q ;IHS/ANMC/HMW Original
+36 ;IHS/ANMC/HMW Modified for cache
IF ^%ZOSF("OS")["MSM"
IF ZITO
IF $ZC
SET ZIX(0)="Socket closed: MSM Error $ZB="_$ZB
SET ZIX=""
QUIT
+37 ;IHS/ANMC/HMW Modified for cache, BUT I don't think $ZEOF works like this. Test.
IF ^%ZOSF("OS")["OpenM"
IF ZITO
IF $ZEOF
SET ZIX(0)="Socket closed: Cache Error $ZB="_$ZB
SET ZIX=""
QUIT
+38 IF 'ZITO
READ ZIX
SET INOK=1
QUIT
+39 ;and append result to the string we will check on next pass
+40 SET ZIX=ZIX(2)_ZIX
SET ZIX(2)=""
End DoDot:2
IF $DATA(ZIX(0))!(INOK)
QUIT
End DoDot:1
IF INDI]""
USE INDI
QUIT
+41 ;
+42 ;If we are reading just packets, with no terminators (eg CR LF)
+43 ;
+44 ;If data left in buffer, use that first
+45 IF ZICRLF
IF $LENGTH(ZIX(2))
Begin DoDot:1
+46 SET ZIX=$EXTRACT(ZIX(2),1,512)
SET ZIX(2)=$EXTRACT(ZIX(2),513,$LENGTH(ZIX(2)))
End DoDot:1
IF INDI]""
USE INDI
QUIT
+47 ;
+48 ;Read more from socket
+49 IF ZITO
READ ZIX:ZITO
IF '$TEST
SET ZIX(0)="Connection timed out"
SET ZIX=""
IF INDI]""
USE INDI
QUIT
+50 IF 'ZITO
READ ZIX
+51 ;
+52 SET ZIX=ZIX(2)_ZIX
SET ZIX(2)=""
+53 ;
+54 IF $LENGTH(ZIX)>512
SET ZIX(2)=$EXTRACT(ZIX,513,$LENGTH(ZIX))
SET ZIX=$EXTRACT(ZIX,1,512)
+55 IF INDI]""
USE INDI
+56 QUIT
+57 ;
ERR ; Handle error trap
+1 ;IHS/ANMC/HMW Begin cache mods
+2 ;I $ZE["<DSCON" S ZIX(0)="Remote end disconected" X:$G(ZICHAN) "C 56:ZICHAN S ZICHAN=""""" U:INDI]"" INDI Q ;IHS/ANMC/HMW Original
+3 IF ^%ZOSF("OS")["MSM"
IF $ZE["<DSCON"
SET ZIX(0)="Remote end disconected"
IF $GET(ZICHAN)
XECUTE "C 56:ZICHAN S ZICHAN="""""
IF INDI]""
USE INDI
QUIT
+4 IF ^%ZOSF("OS")["OpenM"
IF (($ZE["<DSCON")!($ZE["<READ"))
Begin DoDot:1
+5 SET ZIX(0)="Remote end disconect"
+6 IF $GET(ZICHAN)
Begin DoDot:2
+7 NEW ZIDEV,ZIPORT
+8 SET ZIPORT=$PIECE(ZICHAN,"^")
+9 SET ZIDEV="|TCP|"_ZIPORT
+10 CLOSE ZIDEV
End DoDot:2
+11 QUIT
End DoDot:1
IF INDI]""
USE INDI
QUIT
+12 ;IHS/ANMC/HMW End cache mods
+13 GOTO ^%ET
QUIT ; Ignore all errors when closing the channel. Just close it.
+1 QUIT
+2 ;
