XUSC1S.m

XUSC1S ;ISCSF/RWF - Interface to Server services. ;10/09/2002  16:59

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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XUSC1S   3424     printed  Feb 18, 2025@23:38:37                                                                                                                                                                                                      Page 2

XUSC1S    ;ISCSF/RWF - Interface to Server services. ;10/09/2002  16:59

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