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