Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XWBTCPH

XWBTCPH.m

Go to the documentation of this file. 
  1. XWBTCPH ;ISC-SF/EG - TCP/IP PROCESS HANDLER ; 4/28/95
  1.  ;;1.0T11;RPC BROKER;;Oct 31, 1995
  1.  ;;V1.0T10;KERNEL RPC BROKER;
  1.  ;Based on:
  1.  ;XQORTCPH ;SLC/KCM - Service TCP Messages [ 12/04/94  9:06 PM ]
  1.  ;XWBTCPH  ;XXX/KCMO converted to use UCX service; 4/28/95
  1.  ;
  1.  ;Modified by ISC-SF/EG
  1.  ; 0. No longer supports old style OERR messages
  1.  ; 1. Makes call to RPC  broker
  1.  ; 2. Handles MSM Server under Windows NT
  1.  ; 3. Handles MSM under Unix - same as DSM
  1.  ; 4. Result of an rpc call can be a closed form of global
  1.  ; 5. Can receive a large local array, within limits of job
  1.  ;    partition size.
  1.  ; 6. Sets default device to NULL device prior to call, restores
  1.  ;    at termination.  Prevents garbage from 'talking' calls.
  1.  ; 7. All reads have a timeout.
  1.  ; 8. Intro message is sent when first connected.
  1.  ;
  1. EN ; -- Main entry point for the UCX service call
  1.  N TYPE,XWBTBUF,XWBTBUF1,XWBTDEV,XWBTLEN,XWBTOS,XWBTRTN,XWBWRAP
  1.  N X,XWBL,XWB1,XWB2,Y,XWBTIME,XWBPTYPE,XWBPLEN,XWBNULL,XWBODEV
  1.  S XWBTIME=1
  1.  S XWBOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",1:"MSM")
  1.  S XWBNULL=$S(XWBOS="DSM":"NLA0:",1:"")
  1.  IF XWBOS="DSM" D
  1.  . IF '$D(%)#2 S %=$P($ZIO,":")_":" ; Call with dsm$xecute()
  1.  . S (XWBTDEV,IO,IO(0))=%,X=$E(%_"WKSTA",1,15)
  1.  . D SETENV^%ZOSV
  1.  . O IO:(SHARE) X ^%ZOSF("TRMOFF")
  1.  IF XWBOS="MSM"!(XWBOS="UNIX") D
  1.  . S (XWBTDEV,IO,IO(0))=56
  1.  IF XWBOS="DSM" S $ETRAP="S %ZTER11S=$STACK D ETRAP^XWBTCPH"
  1.  E  S X="ETRAP^XWBTCPH",@^%ZOSF("TRAP")
  1.  S DIQUIET=1,X="ETRAP^XWBTCPH",@^%ZOSF("TRAP") D DT^DICRW
  1.  ;S DIQUIET=1 D DT^DICRW
  1.  S U="^"
  1.  ;
  1. MAIN ; -- main message processing loop
  1.  F  D  Q:XWBTBUF="#BYE#"
  1.  . ;
  1.  . ; -- read client request
  1.  . R XWBTBUF#15:600 IF '$T S XWBTBUF="#BYE#" W XWBTBUF,$C(4),! Q
  1.  . IF $L(XWBTBUF)=0 S XWBTBUF="#BYE#" W XWBTBUF,$C(4),! Q
  1.  . S TYPE=$S($E(XWBTBUF,1,5)="{XWB}":1,1:0)
  1.  . S XWBTLEN=$E(XWBTBUF,6,10)
  1.  . S XWBPLEN=$E(XWBTBUF,11,15)
  1.  . R XWBTBUF#XWBPLEN:XWBTIME
  1.  . I $P(XWBTBUF,U)="TCPconnect" D  Q
  1.  . . W "accept",$C(4),!  ;Ack
  1.  . IF TYPE D
  1.  . . K XWBR
  1.  . . IF XWBTBUF="#BYE#" W "#BYE#",$C(4),! Q  ; -- clean disconnect
  1.  . . S XWBTLEN=XWBTLEN-15
  1.  . . ;IF XWBTLEN>240 S XWBR=$$RCN()
  1.  . . D CALLP^XWBBRK(.XWBR,XWBTBUF)
  1.  . . S XWBPTYPE=$S('$D(XWBPTYPE):1,XWBPTYPE<1:1,XWBPTYPE>6:1,1:XWBPTYPE)
  1.  . IF XWBTBUF="#BYE#" Q
  1.  . IF XWBOS="DSM"!(XWBOS="UNIX") D SNDDSM
  1.  . IF XWBOS="MSM" D SND
  1.  . W $C(4),! ;send eot and flush buffer
  1.  IF 'TYPE D
  1.  . W "#UNKNOWN MESSAGE TYPE#",$C(4),! Q  ;end session
  1.  ;
  1.  C XWBTDEV Q
  1.  ;
  1. SND ; -- Send data (all except DSM)
  1.  N I,T
  1.  ; -- single value
  1.  IF XWBPTYPE=1 S XWBR=$G(XWBR) W XWBR Q
  1.  ; -- table delimited by CR+LF
  1.  IF XWBPTYPE=2 D  Q
  1.  . S I="" F  S I=$O(XWBR(I)) Q:I=""  W XWBR(I),$C(13,10)
  1.  ; -- word processing
  1.  IF XWBPTYPE=3 D  Q
  1.  . S I="" F  S I=$O(XWBR(I)) Q:I=""  W XWBR(I) W:XWBWRAP $C(13,10)
  1.  ; -- global array
  1.  IF XWBPTYPE=4 D  Q
  1.  . S I=XWBR,T=$E(I,1,$L(I)-1) W:$D(@I)>10 @I F  S I=$Q(@I) Q:I=""!(I'[T)  W @I W:XWBWRAP $C(13,10)
  1.  ; -- global instance
  1.  IF XWBPTYPE=5 S XWBR=$G(@XWBR) W XWBR Q
  1.  ; -- variable length records
  1.  IF XWBPTYPE=6 S I="" F  S I=$O(XWBR(I)) Q:I=""  W $C($L(XWBR(I))),XWBR(I)
  1.  Q
  1. SNDDSM ; -- send data for DSM (requires buffer flush (!) every 512 chars)
  1.  N I,T
  1.  ; -- single value
  1.  IF XWBPTYPE=1 S XWBR=$G(XWBR) W XWBR Q
  1.  ; -- table delimited by CR+LF
  1.  I XWBPTYPE=2 D  Q
  1.  . S I="" F  S I=$O(XWBR(I)) Q:I=""  W:($X+$L(XWBR(I)))>512 ! W XWBR(I),$C(13,10)
  1.  ; -- word processing
  1.  IF XWBPTYPE=3 D  Q
  1.  . S I="" F  S I=$O(XWBR(I)) Q:I=""  W:($X+$L(XWBR(I)))>512 ! W XWBR(I) W:XWBWRAP $C(13,10)
  1.  ; -- global array
  1.  IF XWBPTYPE=4 D  Q
  1.  . S I=XWBR,T=$E(I,1,$L(I)-1) W:$D(@I)>10 @I F  S I=$Q(@I) Q:I=""!(I'[T)  W:($X+$L(@I))>512 ! W @I W:XWBWRAP&(@I'=$C(13,10)) $C(13,10)
  1.  ; -- global instance
  1.  IF XWBPTYPE=5 S XWBR=$G(@XWBR) W XWBR Q
  1.  ; -- variable length records
  1.  IF XWBPTYPE=6 S I="" F  S I=$O(XWBR(I)) Q:I=""  W:($X+$L(XWBR(I)))>512 ! W $C($L(XWBR(I))),XWBR(I)
  1.  Q
  1.  ;
  1. ETRAP ; -- on trapped error, send error info to client
  1.  N XWBERR
  1.  S XWBERR=$C(24)_"M  ERROR="_$ZERROR_$C(13,10)_"LAST REF="_$ZR_$C(4)
  1.  U XWBTDEV
  1.  IF XWBOS="DSM" D
  1.  . I $D(XWBTLEN),XWBTLEN,$ZE'["SYSTEM-F" W XWBERR D @^%ZOSF("ERRTN")
  1.  IF XWBOS="MSM" D
  1.  . W XWBERR D @^%ZOSF("ERRTN")
  1.  C XWBTDEV HALT
  1.  ;
  1. RCN() ;read entire buffer in chunks of 240 - save in global
  1.  N I,T
  1. T S T=$R(10000)+1
  1.  L +^TMP("XWB",$J,T):3 IF '$T G T
  1.  F I=1:1:(XWBTLEN\240) D
  1.  . S ^TMP("XWB",$J,T,I)=$$BREAD(240)
  1.  S ^TMP("XWB",$J,T,I+1)=$$BREAD(XWBTLEN#240)
  1.  Q "^TMP(""XWB"","_$J_","_T_")"
  1.  ;
  1. BREAD(L) ;read tcp buffer, L is length
  1.  N E,X,DONE
  1.  S (E,DONE)=0
  1.  R X#L:XWBTIME
  1.  S E=X
  1.  IF $L(E)<L F  D  Q:'DONE
  1.  . IF $L(E)=L S DONE=1 Q
  1.  . R X#(L-$L(E)):XWBTIME
  1.  . S E=E_X
  1.  Q E
  1.  ;