%INET ; slt,bar,CHEM,LD ; 29 Dec 98 14:24;Internet function utility - MSM
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;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.
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
;
S $ZT="ERR^"_$T(+0)
N %,INDI S INDI=$G(IO,$I)
S ZICHAN=0,ZIX(1)="",ZIX(2)=""
S ZIPROT=$G(ZIPROT),ZIPROT=$S('ZIPROT!(ZIPROT=1):"TCP",1:"UDP")
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)
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)
N INDI S INDI=$G(IO,$I) U 56
I '$G(ZICRLF),$L(ZIX)<511 W ZIX_$C(13,10)
E W ZIX W:'$G(ZICRLF) !
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)
N INDI S INDI=$G(IO,$I) U 56 ; note: 4 separate exit points
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
..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
I $ZE["<DSCON" S ZIX(0)="Remote end disconected" X:$G(ZICHAN) "C 56:ZICHAN S ZICHAN=""""" U:INDI]"" INDI Q
G ^%ET
QUIT ; Ignore all errors when closing the channel. Just close it.
Q
%INET ; slt,bar,CHEM,LD ; 29 Dec 98 14:24;Internet function utility - MSM
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+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 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 SET $ZT="ERR^"_$TEXT(+0)
+9 NEW %,INDI
SET INDI=$GET(IO,$IO)
+10 SET ZICHAN=0
SET ZIX(1)=""
SET ZIX(2)=""
+11 SET ZIPROT=$GET(ZIPROT)
SET ZIPROT=$SELECT('ZIPROT!(ZIPROT=1):"TCP",1:"UDP")
+12 CLOSE 56
OPEN 56::5
+13 ;Xecute statements for ^ZCMS (not proper DSM syntax - duh.)
+14 ; :(:1) sets the flag on the TCP port to change the behavior of
+15 ; a WRITE ! to the socket - it will transmit <CR><LF> instead of
+16 ; merely flushing the buffer. See "MSM-Server User's Guide" in the
+17 ; "Using Peripheral Devices" section labeled "TCP/IP Socket Device"
+18 ; for more information.
+19 ; !=$C(13,10)
XECUTE "U 56:(:1)"
+20 XECUTE "U 56::ZIPROT W /SOCKET(ZIDOMAIN,ZIPORT) S %=$KEY=""""!$ZC"
IF %
QUIT
+21 ; $KEY is MSM's "connection" (numeric) identifier
XECUTE "S ZICHAN=$KEY"
+22 IF INDI]""
USE INDI
+23 QUIT
+24 ;
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 SET $ZT="QUIT^"_$TEXT(+0)
+6 XECUTE "C:ZICHAN 56:ZICHAN"
KILL ZICHAN
+7 QUIT
+8 ;
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 NEW INDI
SET INDI=$GET(IO,$IO)
USE 56
+8 IF '$GET(ZICRLF)
IF $LENGTH(ZIX)<511
WRITE ZIX_$CHAR(13,10)
+9 IF '$TEST
WRITE ZIX
IF '$GET(ZICRLF)
WRITE !
+10 IF INDI]""
USE INDI
QUIT
+11 ;
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 ; note: 4 separate exit points
NEW INDI
SET INDI=$GET(IO,$IO)
USE 56
+13 SET ZICRLF=$GET(ZICRLF)
KILL ZIX(0)
+14 SET ZITO=$SELECT('$DATA(ZITO):600,1:ZITO)
SET ZIX(1)=$GET(ZIX(1))
SET ZIX(2)=$GET(ZIX(2))
+15 ;
+16 ; If a <CR> <LF> is expected as delimiter, and should be stripped...
+17 IF 'ZICRLF
Begin DoDot:1
+18 ;Loop until we either get a terminator or a read timeout
+19 NEW INOK
SET INOK=0
SET ZIX=""
FOR
Begin DoDot:2
+20 SET ZIX(2)=ZIX(2)_ZIX
+21 ;If data left in buffer, use that first
+22 IF $LENGTH(ZIX(2))
IF $FIND(ZIX(2),$CHAR(10))
Begin DoDot:3
+23 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)))
+24 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
+25 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
+26 ;Read more from socket...
+27 IF ZITO
READ ZIX:ZITO
IF '$TEST
SET ZIX(0)="Connection timed out"
SET ZIX=""
QUIT
+28 IF ZITO
IF $ZC
SET ZIX(0)="Socket closed: MSM Error $ZB="_$ZB
SET ZIX=""
QUIT
+29 IF 'ZITO
READ ZIX
SET INOK=1
QUIT
+30 ;and append result to the string we will check on next pass
+31 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
+32 ;
+33 ;If we are reading just packets, with no terminators (eg CR LF)
+34 ;
+35 ;If data left in buffer, use that first
+36 IF ZICRLF
IF $LENGTH(ZIX(2))
Begin DoDot:1
+37 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
+38 ;
+39 ;Read more from socket
+40 IF ZITO
READ ZIX:ZITO
IF '$TEST
SET ZIX(0)="Connection timed out"
SET ZIX=""
IF INDI]""
USE INDI
QUIT
+41 IF 'ZITO
READ ZIX
+42 ;
+43 SET ZIX=ZIX(2)_ZIX
SET ZIX(2)=""
+44 ;
+45 IF $LENGTH(ZIX)>512
SET ZIX(2)=$EXTRACT(ZIX,513,$LENGTH(ZIX))
SET ZIX=$EXTRACT(ZIX,1,512)
+46 IF INDI]""
USE INDI
+47 QUIT
+48 ;
ERR ; Handle error trap
+1 IF $ZE["<DSCON"
SET ZIX(0)="Remote end disconected"
IF $GET(ZICHAN)
XECUTE "C 56:ZICHAN S ZICHAN="""""
IF INDI]""
USE INDI
QUIT
+2 GOTO ^%ET
QUIT ; Ignore all errors when closing the channel. Just close it.
+1 QUIT
