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

XOBVTCP.m

Go to the documentation of this file.
  1. XOBVTCP ;; mjk/alb - VistALink TCP Utilities ; 07/27/2002 13:00
  1. ;;1.6;VistALink Security;**4**;May 08, 2009;Build 7
  1. ; ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ; -- called from protocol action at START^XOBUM1
  1. START(XOBPORT,XOBCFG) ;
  1. ;
  1. ; -- set up environment
  1. N XOBOK
  1. S XOBOK=0
  1. S U="^" D HOME^%ZIS
  1. ;
  1. ; -- if no port, set to default
  1. I $G(XOBPORT)="" N XOBPORT S XOBPORT=8000
  1. ;
  1. I $$LOCK(XOBPORT) D
  1. . D UNLOCK(XOBPORT)
  1. . ; -- JOB command same for CacheNT and DSM
  1. . J LISTENER^XOBVTCPL(XOBPORT,$G(XOBCFG))::5
  1. . S XOBOK=$T
  1. E D
  1. . S XOBOK=0
  1. Q XOBOK
  1. ;
  1. UCX ; -- old VMS TCPIP (UCX) multi-thread entry point [for DSM]
  1. ; -- Called from VistALink .com files
  1. ;
  1. N XOBEC
  1. D ESET
  1. S (IO,IO(0))="SYS$NET"
  1. ; **VMS specific code, need to share device**
  1. O IO:(TCPDEV:BLOCKSIZE=512):60 E S ^TMP("XOB DSM CONNECT FAILURE",$H)="" Q
  1. U IO
  1. S XOBEC=$$NEWOK^XOBVTCPL()
  1. I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
  1. I 'XOBEC D SPAWN^XOBVLL
  1. Q
  1. ;
  1. CACHEVMS ; -- VMS TCPIP (UCX) multi-thread entry point for Cache for VMS
  1. ; -- Called from VistALink .com files
  1. ;
  1. N XOBEC
  1. D ESET
  1. S (IO,IO(0))="SYS$NET"
  1. ;
  1. O IO::5
  1. U IO:(::"-M") ;Packet mode like DSM
  1. ;
  1. S XOBEC=$$NEWOK^XOBVTCPL()
  1. I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
  1. I 'XOBEC D SPAWN^XOBVLL
  1. Q
  1. ;
  1. CACHELNX ; -- multi-thread entry point for Cache for Linux
  1. ; -- Called from XINETD service files
  1. ;
  1. N XOBEC
  1. D ESET
  1. S (IO,IO(0))=$P
  1. ;
  1. O IO::5
  1. U IO:(::"-M") ;Packet mode like DSM
  1. ;
  1. S XOBEC=$$NEWOK^XOBVTCPL()
  1. I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
  1. I 'XOBEC D SPAWN^XOBVLL
  1. Q
  1. ;
  1. GTMLNX ; -- Linux xinetd multi-thread entry point for GT.M
  1. ;
  1. N XOBEC,TMP,X,%
  1. D ESET
  1. ;
  1. ; **GTM/linux specific code**
  1. S (IO,IO(0))=$P,@("$ZT=""""")
  1. X "U IO:(nowrap:nodelimiter:IOERROR=""TRAP"")" ;Setup device
  1. S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)"""),X=""
  1. X "ZSHOW ""D"":TMP"
  1. F %=1:1 Q:'$D(TMP("D",%)) S X=TMP("D",%) Q:X["LOCAL"
  1. S IO("IP")=$P($P(X,"REMOTE=",2),"@"),IO("PORT")=+$P($P(X,"LOCAL=",2),"@",2)
  1. ;End GT.M code
  1. ;
  1. S XOBEC=$$NEWOK^XOBVTCPL()
  1. I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
  1. I 'XOBEC D COUNT^XUSCNT(1),SPAWN^XOBVLL,COUNT^XUSCNT(-1)
  1. Q
  1. ;
  1. ;Sample linux scripts
  1. ;xinetd script
  1. ;vvvvvvvvvvvvvvvvvvvvvvvvv
  1. ;service vistalink
  1. ;{
  1. ; socket_type = stream
  1. ; port = 18001
  1. ; type = UNLISTED
  1. ; user = vista
  1. ; wait = no
  1. ; disable = no
  1. ; server = /bin/bash
  1. ; server_args = /home/vista/dev/vistalink.sh
  1. ; passenv = REMOTE_HOST
  1. ;}
  1. ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  1. ;
  1. ;cat /home/vista/dev/vistalink.sh
  1. ;vvvvvvvvvvvvvvvvvvvvvvvvvvvv
  1. ;#!/bin/bash
  1. ;#RPC Broker
  1. ;cd /home/vista/dev
  1. ;. ./gtmprofile
  1. ;$gtm_dist/mumps -r GTMLNX^XOBVTCP
  1. ;exit 0
  1. ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  1. ;
  1. SERVICE ; -- service entry point (for VMS TCP/IP & LINUX XINETD utilities)
  1. ; TODO: possible single entry point for os service calls; needs work and has not been tested
  1. N XOBEC,XOBMOS,XOBSOS
  1. D ESET
  1. S XOBMOS=$$OS^XOBVSKT()
  1. I XOBMOS'["OpenM" S $EC=",U98,"
  1. S XOBSOS=$$SYSOS^XOBVLIB(XOBMOS)
  1. I XOBMOS'["VMS"!(XOBMOS'["UNIX") S $EC=",U97,"
  1. ;
  1. S (IO,IO(0))=$S(XOBSOS="VMS":"SYS$NET","UNIX":$P)
  1. ;
  1. O IO::5
  1. U IO:(::"-M") ;Packet mode like DSM
  1. ;
  1. S XOBEC=$$NEWOK^XOBVTCPL()
  1. I XOBEC D LOGINERR^XOBVTCPL(XOBEC,IO)
  1. I 'XOBEC D SPAWN^XOBVLL
  1. Q
  1. ;
  1. ESET ;Set initial error trap
  1. N $ET,$ES
  1. S U="^",$ET="D APPERROR^%ZTER(""VistALink Error - TCP Utilities"") H" ;Set up the error trap ;*4
  1. Q
  1. ;
  1. STARTUP ; -- called by TaskMan startup option [Option: XOBV LISTENER STARTUP]
  1. ; and could be called by VMS .com procedure
  1. ;
  1. ; -- quit if not Cache OS
  1. I $$GETOS()'["OpenM" G STARTUPQ
  1. ; -- clear log of non-active listeners
  1. D CLEARLOG
  1. ; -- get config for BOX-VOL and start it!
  1. D STARTCFG($$GETCFG())
  1. STARTUPQ ;
  1. Q
  1. ;
  1. CLEARLOG ; -- clear log of non-active listeners
  1. N DIK,DA,Y,XOBI,XOB0,XOBPORT
  1. ;
  1. S XOBI=0
  1. F S XOBI=$O(^XOB(18.04,XOBI)) Q:'XOBI D
  1. . S XOB0=$G(^XOB(18.04,XOBI,0))
  1. . S XOBPORT=+$P(XOB0,U,2)
  1. . ; -- make sure listener is not running
  1. . I $$LOCK(XOBPORT) D
  1. . . S DIK="^XOB(18.04,",DA=XOBI D ^DIK
  1. . . D UNLOCK(XOBPORT)
  1. ;
  1. Q
  1. ;
  1. STARTCFG(XOBCFG) ; -- start a configurations listeners
  1. N CFG0,LSTR,LSTR0,XOBPORT,STARTUP,XOBOK
  1. S CFG0=$G(^XOB(18.03,XOBCFG,0))
  1. ;
  1. ; -- quit if no configuration
  1. I CFG0="" G CFGQ
  1. ;
  1. ; -- quit if not Cache...for now!
  1. I $$GETOS()'["OpenM" G CFGQ
  1. ;
  1. S LSTR=0
  1. F S LSTR=$O(^XOB(18.03,XOBCFG,"PORTS",LSTR)) Q:'LSTR D
  1. . S LSTR0=$G(^XOB(18.03,XOBCFG,"PORTS",LSTR,0))
  1. . S XOBPORT=+$P(LSTR0,U,1)
  1. . S STARTUP=$P(LSTR0,U,2)
  1. . ;
  1. . ; -- if ok to start, port # defined and not already started
  1. . I XOBPORT,STARTUP,$$LOCK^XOBVTCP(XOBPORT) D
  1. . . D UNLOCK(XOBPORT)
  1. . . D UPDATE^XOBVTCP(XOBPORT,1,XOBCFG)
  1. . . S XOBOK=$$START(XOBPORT,XOBCFG)
  1. . . I 'XOBOK D UPDATE(XOBPORT,5,XOBCFG)
  1. ;
  1. CFGQ ;
  1. Q
  1. ;
  1. LOCK(XOBPORT) ;-- Lock port
  1. ;
  1. ; Used to prevent another process from attempting to start the Listener
  1. ; when it is already running.
  1. ;
  1. ; Input:
  1. ; XOBPORT - Port #
  1. ;
  1. ; Output:
  1. ; Function Value - Returns 1 if lock was successful, 0 otherwise
  1. ;
  1. Q $$ACTION("LOCK",XOBPORT)
  1. ;
  1. ;
  1. UNLOCK(XOBPORT) ;-- Unlock port
  1. ;
  1. ; Used to release a lock created by $$LOCK.
  1. ;
  1. ; Input:
  1. ; XOBPORT - Port #
  1. ;
  1. ; Output:
  1. ; None
  1. ;
  1. N X
  1. S X=$$ACTION("UNLOCK",XOBPORT)
  1. Q
  1. ;
  1. ACTION(ACTION,XOBPORT) ; -- do lock action
  1. N ENV,VOL,UCI,BOX
  1. ;
  1. S XOBPORT=+$G(XOBPORT)
  1. ;
  1. S ENV=$$GETENV()
  1. S VOL=$P(ENV,U,2)
  1. S UCI=$P(ENV,U)
  1. S BOX=$P(ENV,U,4)
  1. ;
  1. I ACTION="LOCK",XOBPORT L +^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT):1 Q $T
  1. I ACTION="UNLOCK",XOBPORT L -^XOB(18.01,"VistALink Listener",VOL,UCI,BOX,XOBPORT) Q 1
  1. Q 0
  1. ;
  1. ;
  1. UPDATE(XOBPORT,XOBSTAT,XOBCFG) ; -- update VISTALINK LISTENER STARTUP LOG for listener
  1. N DIC,Y,X,XOBBOX
  1. S XOBBOX=$$GETBOXN()
  1. ;
  1. ; -- set up lookup call
  1. S DIC="^XOB(18.04,"
  1. S DIC(0)="MLX"
  1. S DIC("DR")=".02////"_XOBPORT
  1. S DIC("S")="IF $P(^(0),U,2)="_XOBPORT
  1. S X=XOBBOX
  1. ;
  1. D ^DIC
  1. ; -- quit if lookup failed
  1. I +Y>0 D UPDLOG(+Y,XOBPORT,XOBSTAT,$G(XOBCFG))
  1. Q
  1. ;
  1. UPDLOG(XOBDA,XOBPORT,XOBSTAT,XOBCFG) ; -- do edit
  1. N DA,DIE,DR,Y,X
  1. ;
  1. L +^XOB(18.04,XOBDA,0)
  1. ; -- set basic fields
  1. S DA=XOBDA
  1. S DIE="^XOB(18.04,"
  1. S DR=".02////"_XOBPORT_";.03////"_XOBSTAT_";.05////^S X=$$NOW^XLFDT"
  1. ; -- set config if defined, otherwise delete
  1. S DR=DR_";.06////"_$S($G(XOBCFG)]"":XOBCFG,1:"@")
  1. ; -- set user if defined, otherwise delete
  1. S DR=DR_";.04////"_$S($G(DUZ)]"":DUZ,1:"@")
  1. ;
  1. D ^DIE
  1. L -^XOB(18.04,XOBDA,0)
  1. ;
  1. Q
  1. ;
  1. GETENV() ; -- get environment variable
  1. ;-- Get environment of current system i.e. Y=UCI^VOL/DIR^NODE^BOX LOOKUP
  1. N Y
  1. D GETENV^%ZOSV
  1. Q Y
  1. ;
  1. GETOS() ;-- Get operating system
  1. ;
  1. ; This function will determine which operating system is being used.
  1. ;
  1. ; Input:
  1. ; None
  1. ;
  1. ; Output:
  1. ; Operating system value i.e. OpenM-NT for OpenM.
  1. ;
  1. ;-- Get operating system
  1. Q $P($G(^%ZOSF("OS")),"^")
  1. ;
  1. ;
  1. GETBOX() ; -- get box ien
  1. ;
  1. Q $$FIND1^DIC(14.7,"","BX",$P($$GETENV(),U,4),"","","")
  1. ;
  1. GETBOXN() ; -- get box name
  1. ;
  1. Q $P($$GETENV(),U,4)
  1. ;
  1. GETCFG() ; -- get config ien for current BOX-VOL pair
  1. Q +$P($G(^XOB(18.01,1,"CONFIG",+$O(^XOB(18.01,1,"CONFIG","B",+$$GETBOX(),"")),0)),U,2)
  1. ;