XUSC1S ;ISCSF/RWF - Interface to Server services. ;10/09/2002 16:59 [ 07/29/2004 9:01 AM ]
;;8.0;KERNEL;**283**;Jul 10, 1995
Q
;XUSC is used to pass data around.
; 5224 is the standard VA port for the Services Server.
LISTEN ;only for OpenM
S $ETRAP="D ^%ZTER H"
D LISTEN^%ZISTCPS(5500,"ONT^XUSC1S")
Q
DSM ;Test listener
S IO=% O IO:(SHARE) U IO ;Setup TCP port
S IO(0)="_NLA0:" O IO(0) ;Setup null device
D SVR
Q
MSM ;Entry point from MSERVER
S IO=56,IO(0)=46 O 46 ;Null device
D SVR C IO
Q
ONT ;Cache/OpenM
S IO=$I,IO(0)="//./nul" O IO(0)
D SVR
Q
;
SVR ;Entry point when we have a connect
;See that IO=TCP device, and IO(0) is Null device and Open.
N XUSC11,XUSCER,XUSCEXIT,XUSCCMD,XUSCDAT,ZTQUEUED D SETUP
N $ESTACK,$ETRAP S $ETRAP="D ^%ZTER H"
K ^XUTL("XQ",$J) S ^XUTL("XQ",$J,0)=$$NOW^XLFDT
F D CREAD Q:XUSCEXIT D Q:XUSCEXIT
. I XUSCCMD="" S XUSC11("TCNT")=$G(XUSC11("TCNT"))+1 S:$$STOP!(XUSC11("TCNT")>10) XUSCEXIT=1 Q
. I XUSCCMD'?4A D SEND("500 Bad CMD: "_$E(XUSCCMD,1,20)) Q
. I $T(@XUSCCMD)="" D SEND("500 ") Q
. S XUSC11("TCNT")=0
. D @XUSCCMD I $G(XUSCER) D TRACE("ERROR: "_XUSCER)
. Q
S:XUSCEXIT IO("C")=1
I '$G(XUSCDBUG) K ^TMP("XUSCI",$J),^TMP("XUSCO",$J) ;Clean up
D TRACE("Exit")
Q
HELO ;Process HELO
S XUSC11("SITE")=$P(XUSCDAT," ")
;Do any check on who is sending
D SEND("220 "_$$KSP^XUPARAM("WHERE")_" Ready for "_XUSCDAT)
Q
;
NOOP ;
D SEND("250 OK")
Q
;
DATA ;Process DATA
; The DATA cmd can pass some parameters as well, this could be passed
; to the processing routine also.
N XUSCRTN,P,I,DUZ S DUZ=0,DUZ(0)="@"
D TRACE("Get Data")
S (XUSCRTN,XUSC11("DATA"))=XUSCDAT K @XUSCIN,@XUSCOUT
D DATA^XUSC1S1(XUSCIN,.XUSC11)
S P="" F I=1:1 Q:'$D(XUSC11("P"_I)) S P=P_"P"_I_"="_XUSC11("P"_I)_", "
D TRACE("PARAM "_P)
;Use the Null Device
U IO(0)
;Now call soneone to process the data
;I XUSC11("P1")="SERVER" D SERVER^XUSC1S2
I XUSC11("P1")="PING" M @XUSCOUT=@XUSCIN
U IO ;Back to the TCP device
Q
TURN ;Turn and send responce
D SEND("220 OK")
D SDATA^XUSC1S1(XUSCOUT,XUSC11("P1"))
D CREAD,TRACE("Data Sent ") ;Look for 220 ok
Q
QUIT ;Process QUIT
D TRACE("QUIT")
S XUSCMSG="",XUSCEXIT=1
Q
;
CREAD ;Read a string
N $ETRAP S $ETRAP="S $EC="""" G CREX"
N I S (Y,XUSCDAT,XUSCCMD)="",XUSCER=0
F I=0:1:255 R X#1:XUSCTIME S:'$T XUSCER=1 D TRACE("Char "_$A(X)) Q:X=$C(10)!XUSCER S Y=Y_X
S Y=$TR(Y,$C(13,10)),XUSCCMD=$P(Y," "),XUSCDAT=$P(Y," ",2,99)
D TRACE("Cmd Read "_Y)
Q
CREX S XUSCEXIT=1,XUSCER="1 Error"
D TRACE("CREAD error: "_$$EC^%ZOSV_" Y="_Y)
Q
;
SEND(MSG) ;Send a cmd MSG
N $ETRAP S $ETRAP="S $EC="""" D CREX"
D TRACE("Cmd Send "_MSG)
W MSG,$C(13,10),!
Q
;
SETUP ;Setup needed variables
K IO("C") S (XUSCER,XUSCEXIT)=0,XUSCTIME=345,ZTQUEUED=.5 ;**** CHANGE BACK
S XUSCTRC="S: ",XUSC11("P1")="TEXT"
S XUSCIN=$NA(^TMP("XUSCI",$J)),XUSCOUT=$NA(^TMP("XUSCO",$J))
S XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
D TRACE(-1),TRACE("Server Setup")
Q
STOP(%) ;Should the server stop.
I $G(%)=1 S ^TMP("XUSC1","STOP")=1 Q
I $G(%)=-1 K ^TMP("XUSC1","STOP") Q
I $D(^TMP("XUSC1","STOP")) Q 1
Q 0
;
TRACE(S1) ;
N H,%
I S1=-1 K ^TMP("XUSC1",$J) Q
Q:'$G(XUSCDBUG)
S H=$P($H,",",2),H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
L +^TMP("XUSC1",$J)
S %=$G(^TMP("XUSC1",$J,0))+1,^(0)=%,^(%)=H_$G(XUSCTRC)_S1
L -^TMP("XUSC1",$J)
Q
;
XUSC1S ;ISCSF/RWF - Interface to Server services. ;10/09/2002 16:59 [ 07/29/2004 9:01 AM ]
+1 ;;8.0;KERNEL;**283**;Jul 10, 1995
+2 QUIT
+3 ;XUSC is used to pass data around.
+4 ; 5224 is the standard VA port for the Services Server.
LISTEN ;only for OpenM
+1 SET $ETRAP="D ^%ZTER H"
+2 DO LISTEN^%ZISTCPS(5500,"ONT^XUSC1S")
+3 QUIT
DSM ;Test listener
+1 ;Setup TCP port
SET IO=%
OPEN IO:(SHARE)
USE IO
+2 ;Setup null device
SET IO(0)="_NLA0:"
OPEN IO(0)
+3 DO SVR
+4 QUIT
MSM ;Entry point from MSERVER
+1 ;Null device
SET IO=56
SET IO(0)=46
OPEN 46
+2 DO SVR
CLOSE IO
+3 QUIT
ONT ;Cache/OpenM
+1 SET IO=$IO
SET IO(0)="//./nul"
OPEN IO(0)
+2 DO SVR
+3 QUIT
+4 ;
SVR ;Entry point when we have a connect
+1 ;See that IO=TCP device, and IO(0) is Null device and Open.
+2 NEW XUSC11,XUSCER,XUSCEXIT,XUSCCMD,XUSCDAT,ZTQUEUED
DO SETUP
+3 NEW $ESTACK,$ETRAP
SET $ETRAP="D ^%ZTER H"
+4 KILL ^XUTL("XQ",$JOB)
SET ^XUTL("XQ",$JOB,0)=$$NOW^XLFDT
+5 FOR
DO CREAD
IF XUSCEXIT
QUIT
Begin DoDot:1
+6 IF XUSCCMD=""
SET XUSC11("TCNT")=$GET(XUSC11("TCNT"))+1
IF $$STOP!(XUSC11("TCNT")>10)
SET XUSCEXIT=1
QUIT
+7 IF XUSCCMD'?4A
DO SEND("500 Bad CMD: "_$EXTRACT(XUSCCMD,1,20))
QUIT
+8 IF $TEXT(@XUSCCMD)=""
DO SEND("500 ")
QUIT
+9 SET XUSC11("TCNT")=0
+10 DO @XUSCCMD
IF $GET(XUSCER)
DO TRACE("ERROR: "_XUSCER)
+11 QUIT
End DoDot:1
IF XUSCEXIT
QUIT
+12 IF XUSCEXIT
SET IO("C")=1
+13 ;Clean up
IF '$GET(XUSCDBUG)
KILL ^TMP("XUSCI",$JOB),^TMP("XUSCO",$JOB)
+14 DO TRACE("Exit")
+15 QUIT
HELO ;Process HELO
+1 SET XUSC11("SITE")=$PIECE(XUSCDAT," ")
+2 ;Do any check on who is sending
+3 DO SEND("220 "_$$KSP^XUPARAM("WHERE")_" Ready for "_XUSCDAT)
+4 QUIT
+5 ;
NOOP ;
+1 DO SEND("250 OK")
+2 QUIT
+3 ;
DATA ;Process DATA
+1 ; The DATA cmd can pass some parameters as well, this could be passed
+2 ; to the processing routine also.
+3 NEW XUSCRTN,P,I,DUZ
SET DUZ=0
SET DUZ(0)="@"
+4 DO TRACE("Get Data")
+5 SET (XUSCRTN,XUSC11("DATA"))=XUSCDAT
KILL @XUSCIN,@XUSCOUT
+6 DO DATA^XUSC1S1(XUSCIN,.XUSC11)
+7 SET P=""
FOR I=1:1
IF '$DATA(XUSC11("P"_I))
QUIT
SET P=P_"P"_I_"="_XUSC11("P"_I)_", "
+8 DO TRACE("PARAM "_P)
+9 ;Use the Null Device
+10 USE IO(0)
+11 ;Now call soneone to process the data
+12 ;I XUSC11("P1")="SERVER" D SERVER^XUSC1S2
+13 IF XUSC11("P1")="PING"
MERGE @XUSCOUT=@XUSCIN
+14 ;Back to the TCP device
USE IO
+15 QUIT
TURN ;Turn and send responce
+1 DO SEND("220 OK")
+2 DO SDATA^XUSC1S1(XUSCOUT,XUSC11("P1"))
+3 ;Look for 220 ok
DO CREAD
DO TRACE("Data Sent ")
+4 QUIT
QUIT ;Process QUIT
+1 DO TRACE("QUIT")
+2 SET XUSCMSG=""
SET XUSCEXIT=1
+3 QUIT
+4 ;
CREAD ;Read a string
+1 NEW $ETRAP
SET $ETRAP="S $EC="""" G CREX"
+2 NEW I
SET (Y,XUSCDAT,XUSCCMD)=""
SET XUSCER=0
+3 FOR I=0:1:255
READ X#1:XUSCTIME
IF '$TEST
SET XUSCER=1
DO TRACE("Char "_$ASCII(X))
IF X=$CHAR(10)!XUSCER
QUIT
SET Y=Y_X
+4 SET Y=$TRANSLATE(Y,$CHAR(13,10))
SET XUSCCMD=$PIECE(Y," ")
SET XUSCDAT=$PIECE(Y," ",2,99)
+5 DO TRACE("Cmd Read "_Y)
+6 QUIT
CREX SET XUSCEXIT=1
SET XUSCER="1 Error"
+1 DO TRACE("CREAD error: "_$$EC^%ZOSV_" Y="_Y)
+2 QUIT
+3 ;
SEND(MSG) ;Send a cmd MSG
+1 NEW $ETRAP
SET $ETRAP="S $EC="""" D CREX"
+2 DO TRACE("Cmd Send "_MSG)
+3 WRITE MSG,$CHAR(13,10),!
+4 QUIT
+5 ;
SETUP ;Setup needed variables
+1 ;**** CHANGE BACK
KILL IO("C")
SET (XUSCER,XUSCEXIT)=0
SET XUSCTIME=345
SET ZTQUEUED=.5
+2 SET XUSCTRC="S: "
SET XUSC11("P1")="TEXT"
+3 SET XUSCIN=$NAME(^TMP("XUSCI",$JOB))
SET XUSCOUT=$NAME(^TMP("XUSCO",$JOB))
+4 SET XUSCDBUG=$$GET^XPAR("SYS","XUSC1 DEBUG",,"Q")
+5 DO TRACE(-1)
DO TRACE("Server Setup")
+6 QUIT
STOP(%) ;Should the server stop.
+1 IF $GET(%)=1
SET ^TMP("XUSC1","STOP")=1
QUIT
+2 IF $GET(%)=-1
KILL ^TMP("XUSC1","STOP")
QUIT
+3 IF $DATA(^TMP("XUSC1","STOP"))
QUIT 1
+4 QUIT 0
+5 ;
TRACE(S1) ;
+1 NEW H,%
+2 IF S1=-1
KILL ^TMP("XUSC1",$JOB)
QUIT
+3 IF '$GET(XUSCDBUG)
QUIT
+4 SET H=$PIECE($HOROLOG,",",2)
SET H=(H\3600)_":"_(H#3600\60)_":"_(H#60)_" "
+5 LOCK +^TMP("XUSC1",$JOB)
+6 SET %=$GET(^TMP("XUSC1",$JOB,0))+1
SET ^(0)=%
SET ^(%)=H_$GET(XUSCTRC)_S1
+7 LOCK -^TMP("XUSC1",$JOB)
+8 QUIT
+9 ;
