ZINETNTM.m

%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