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

ZISTCPS.m

Go to the documentation of this file. 
  1. %ZISTCPS ;ISF/RWF - DEVICE HANDLER TCP/IP SERVER CALLS ;06/20/2005  09:11
  1.  ;;8.0;KERNEL;**78,118,127,225,275,388**;Jul 10, 1995
  1.  Q
  1.  ;
  1. CLOSE ;Close and reset
  1.  G CLOSE^%ZISTCP
  1.  Q
  1.  ;
  1.  ;In ZRULE, set ZISQUIT=1 to quit
  1. LISTEN(SOCK,RTN,ZRULE) ;Listen on socket, start routine
  1.  N %A,ZISOS,X,NIO,EXIT
  1.  N $ES,$ET S $ETRAP="D OPNERR^%ZISTCPS"
  1.  S ZISOS=^%ZOSF("OS"),ZRULE=$G(ZRULE)
  1.  S POP=1
  1.  D GETENV^%ZOSV S U="^",XUENV=Y,XQVOL=$P(Y,U,2)
  1.  S POP=1 D LONT:ZISOS["OpenM",LGTM:ZISOS["GT.M"
  1.  I 'POP C NIO ;Close port
  1.  Q
  1.  ;
  1.  ;
  1. LONT ;Open port in Accept mode with standard terminators.
  1.  N %ZA,NEWCHAR
  1.  S NIO="|TCP|"_SOCK,EXIT=0
  1.  ;(adr:sock:term:ibuf:obuf:queue)
  1.  O NIO:(:SOCK:"AT"::512:512:10):30 Q:'$T  S POP=0 U NIO
  1.  ;Wait on read for a connect
  1. LONT2 F  U NIO R *NEWCHAR:30 S EXIT=$$EXIT Q:$T!EXIT
  1.  I EXIT C NIO Q
  1.  ;JOB params (:Concurrent Server bit:principal input:principal output)
  1.  J CHILDONT^%ZISTCPS(NIO,RTN):(:16::):10 S %ZA=$ZA
  1.  I %ZA\8196#2=1 W *-2 ;Job failed to clear bit
  1.  G LONT2
  1.  ;
  1. CHILDONT(IO,RTN) ;Child process for OpenM
  1.  S $ETRAP="D ^%ZTER L  HALT",IO=$ZU(53)
  1.  U IO:(::"-M") ;Work like DSM
  1.  S NEWJOB=$$NEWOK
  1.  I 'NEWJOB W "421 Service temporarily down.",$C(13,10),!
  1.  I NEWJOB K NEWJOB D VAR,@RTN
  1.  HALT
  1.  ;
  1. VAR ;Setup IO variables
  1.  S IO(0)=IO,IO(1,IO)="",POP=0
  1.  S IOT="TCP",IOST="P-TCP",IOST(0)=0
  1.  S IOF=$$FLUSHCHR^%ZISTCP
  1.  S ^XUTL("XQ",$J,0)=$$DT^XLFDT
  1.  Q
  1. NEWOK() ;Is it OK to start a new process
  1.  I $G(^%ZIS(14.5,"LOGON",^%ZOSF("VOL"))) Q 0
  1.  I $$AVJ^%ZOSV()<3 Q 0
  1.  Q 1
  1. OPNERR ;
  1.  S POP=1,EXIT=1,IO("ERROR")=$ECODE,$ECODE=""
  1.  Q
  1. EXIT() ;See if time to exit
  1.  I $$S^%ZTLOAD Q 1
  1.  N ZISQUIT S ZISQUIT=0
  1.  I $L(ZRULE) X ZRULE I $G(ZISQUIT) Q 1
  1.  Q 0
  1.  ;
  1. LGTM ;GT.M multi thread server
  1.  N %A K ^TMP("ZISTCP",$J)
  1.  S $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"
  1.  S NIO="SCK$"_$S($J>86400:$J,1:84600+$J) ;Construct a dummy, but "unique" devicename for job
  1.  D LOG("Open for Listen "_NIO)
  1.  ;Open the device
  1.  O NIO:(ZLISTEN=SOCK_":TCP":ATTACH="listener"):30:"SOCKET"
  1.  I '$T D LOG("Can't Open Socket: "_SOCK) Q
  1.  U NIO S NIO("ZISTCP",0)=$KEY D LOG("Have port.")
  1.  ;Start Listening
  1.  W /LISTEN(1) S NIO("ZISTCP",1)=$KEY D LOG("Start Listening. "_NIO("ZISTCP",1))
  1.  ;Wait for connection
  1. LG2 S %A=0,EXIT=0 F  D  Q:%A!EXIT
  1.  . W /WAIT(30) ;Wait for connect
  1.  . I $P($KEY,"|",1)="CONNECT" S NIO("ZISTCP",2)=$KEY,%A=1
  1.  . S EXIT=$$EXIT
  1.  . Q
  1.  I EXIT C NIO Q
  1.  ;
  1.  S NIO("SOCK")=$P($G(NIO("ZISTCP",2)),"|",2)
  1.  D LOG("Got connection on "_NIO("SOCK"))
  1.  I '$$NEWOK D  G LG2
  1.  . U NIO:(SOCKET=NIO("SOCK")) W "421 Service temporarily down.",$C(13,10),#
  1.  . C NIO:(SOCKET=NIO("SOCK")) K NIO("ZISTCP",2)
  1.  . Q
  1.  ;Close the main socket
  1.  C NIO:(SOCKET="listener")
  1.  ;Start a new listener
  1.  J LISTEN^%ZISTCPS(SOCK,RTN,ZRULE)
  1.  ;Use the new socket
  1.  ;U NIO:(SOCKET=NIO("SOCK"):WIDTH=512:NOWRAP:IOERROR="TRAP")
  1.  U NIO:(SOCKET=NIO("SOCK"):WIDTH=512:NOWRAP)
  1.  ;Run the job
  1.  D GTMLNCH(NIO,RTN)
  1.  S POP=0
  1.  Q
  1.  ;
  1. GTMLNCH(IO,RTN) ;Run gt.m job for this conncetion.
  1.  N NIO,SOCK,ZISOS,EXIT,XQVOL,$ETRAP
  1.  S U="^",$ETRAP="D ^%ZTER L  HALT"
  1.  S IO(0)=IO,IO(1,IO)=""
  1.  D VAR,@RTN
  1.  Q $D(IO("C")) ;Use IO("C") to quit server
  1.  ;
  1. LOG(MSG) ;LOG STATUS
  1.  N CNT
  1.  S CNT=$G(^TMP("ZISTCP",$J))+1,^TMP("ZISTCP",$J)=CNT,^($J,CNT)=MSG
  1.  Q
  1.  ;