- %ZOSV ;SFISC/AC,PUG/TOAD,HOU/DHW - View commands & special functions. ;09/15/08 16:41
- ;;8.0;KERNEL;**275,425,499**;Jul 10, 1995;Build 24
- ;
- ACTJ() ; # active jobs
- I $G(^XUTL("XUSYS","CNT")) Q $G(^XUTL("XUSYS","CNT"))
- ;This would also work
- N %I,%FILE,Y
- S %FILE=$$TEMP_"zosv_actj_"_$J_".tmp"
- ZSYSTEM "ps cef -C mumps|wc>"_%FILE
- S %I=$I
- O %FILE
- U %FILE R Y:99 U %I
- C %FILE:DELETE
- F Q:$E(Y)'=" " S $E(Y)=""
- S Y=Y-1,^XUTL("XUSYS","CNT")=Y
- Q Y
- ;
- AVJ() ; # available jobs, Limit is in the OS.
- N V,J
- S V=^%ZOSF("VOL"),J=$O(^XTV(8989.3,1,4,"B",V,0)),J=$P($G(^XTV(8989.3,1,4,J,0),"^^1000"),"^",3)
- Q J-$$ACTJ ;Use signon Max
- ;
- RTNDIR() ; primary routine source directory
- ;Assume /home/xxx/o(/home/xxx/r /home/xxx/w) /home/gtm()
- Q $P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/"
- ;
- TEMP() ; Return path to temp directory
- ;N %TEMP S %TEMP=$P($$RTNDIR," "),%TEMP=$P(%TEMP,"/",1,$L(%TEMP,"/")-2)_"/t/"
- Q $G(^%ZOSF("TMP"),$G(^XTV(8989.3,1,"DEV"),"/tmp/"))
- ;
- PASSALL ;
- U $I:(NOESCAPE:NOTERMINATOR:PASTHRU) Q
- NOPASS ;
- U $I:(ESCAPE:TERMINATOR="":NOPASTHRU) Q
- ;
- GETPEER() ;Get the IP address of a connection peer
- N PEER
- S PEER=$P($ZTRNLNM("SSH_CLIENT")," ") S:PEER="" PEER=$ZTRNLNM("REMOTEHOST")
- S PEER=$S($L(PEER):PEER,$L($G(IO("IP"))):IO("IP"),$L($G(IO("GTM-IP"))):IO("GTM-IP"),1:"")
- I $G(^XTV(8989.3,1,"PEER"))[PEER S PEER="" ;p499
- Q PEER
- ;
- PRGMODE ;Drop into direct mode
- N X,XUCI,XUSLNT
- W ! S ZTPAC=$P($G(^VA(200,+DUZ,.1)),"^",5),XUVOL=^%ZOSF("VOL")
- S X="" X ^%ZOSF("EOFF") R:ZTPAC]"" !,"PAC: ",X:60 D LC^XUS X ^%ZOSF("EON") I X'=ZTPAC W "??",$C(7) Q
- N XMB,XMTEXT,XMY S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$L($T(^XMB)) D BYE^XUSCLEAN K ZTPAC,X,XMB
- D UCI S XUCI=Y D PRGM^ZUA
- F BREAK
- HALT
- ;
- PROGMODE() ; In Application mode
- Q 0 ; This was used to control UCI switching, has no meaning in GT.M
- ;
- UCI ;
- S Y=^%ZOSF("PROD") Q
- ;
- UCICHECK(X) ;
- Q X
- ;
- JOBPAR ; <=====
- N %FILE,%I S %FILE=$$PWD^%ZISH_"zosv_jobpar_"_$J_".tmp"
- ZSYSTEM "ps c -p "_X_"|tail -1>"_%FILE
- S %I=$I
- O %FILE
- U %FILE R Y:99 U %I
- C %FILE:DELETE
- F Q:$E(Y)'=" " S $E(Y)=""
- I +Y=X,$E(Y,$L(Y)-4,$L(Y))="mumps" S Y=^%ZOSF("PROD")
- E S Y=""
- Q
- ;
- SHARELIC(TYPE) ;Used by Cache implementations
- Q
- ;
- PRIORITY ;
- K Y ; VA has this disabled in general.
- Q
- ;
- PRIINQ() ;
- Q 5 ; for now, we're always middle of the road
- ;
- BAUD S X="UNKNOWN"
- Q
- ;
- LGR() ; Last global reference ($REFERENCE)
- Q $R
- ;
- EC() ; Error Code: returning $ZS in format more like $ZE from DSM
- N %ZE
- I $ZS="" S %ZE=""
- S %ZE=$P($ZS,",",2)_","_$P($ZS,",",4)_","_$P($ZS,",")_",-"_$P($ZS,",",3)
- Q %ZE
- ;
- DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
- ;S Y="%" F S Y=$O(@Y) Q:Y="" D
- ;. I $D(@Y)#2 S @(X_"Y)="_Y)
- ;. I $D(@Y)>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
- S Y="%" F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""
- Q
- ;
- ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X
- N %
- S (Y,%)=$P(Y,"*",1) ;I $D(@Y)=0 F S Y=$O(@Y) Q:Y=""!(Y[Y1)
- Q:Y=""
- ;S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
- ;F S Y=$O(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
- F M:$D(@Y) @(X_"Y)="_Y) S Y=$O(@Y) Q:Y=""!(Y'[%)
- Q
- ;
- PARSIZ ;
- S X=3 Q
- ;
- NOLOG ;
- S Y=0 Q
- ;
- GETENV ;Get environment Return Y='UCI^VOL^NODE^BOX LOOKUP'
- N %HOST,%V S %V=^%ZOSF("PROD"),%HOST=$$RETURN("hostname -s")
- S Y=$TR(%V,",","^")_"^"_%HOST_"^"_$P(%V,",",2)_":"_%HOST
- Q
- ;
- VERSION(X) ;return OS version, X=1 - return OS
- Q $S($G(X):$P($ZV," V"),1:+$P($ZV," V",2))
- ;
- OS() ;
- Q "UNIX"
- ;
- SETNM(X) ;Set name, Trap dup's, Fall into SETENV
- N $ETRAP S $ETRAP="S $ECODE="""" Q"
- SETENV ;Set environment X='PROCESS NAME^ '
- S ^XUTL("XUSYS",$J,0)=$H,^("NM")=X ; workaround
- Q
- ;
- SID() ;System ID
- N J1,T S T="~"
- S J1(1)=$ZROUTINES,J1(1)=$P(J1(1)," ")
- S J1(2)=$ZGBLDIR
- Q "1~"_J1(1)_T_J1(2)
- ;
- PRI() ;Check if a mixed OS enviroment.
- ;Default return 1 unless we are on the secondary OS.
- ;Only Cache on a VMS/Linux mix is supported now.
- Q 1
- ;
- T0 ; start RT clock
- Q ; we don't have $ZH on GT.M
- ;
- T1 ; store RT datum w/ZHDIF
- Q ; we don't have $ZH on GT.M
- ;
- ZHDIF ;Display dif of two $ZH's
- W !," ET=",$J(($P(%ZH1,",")-$P(%ZH0,",")*86400)+($P(%ZH1,",",2)-$P(%ZH0,",",2)),6,2)
- Q
- ;
- ;Code moved to %ZOSVKR, Comment out if needed.
- LOGRSRC(OPT,TYPE,STATUS) ;record resource usage in ^XTMP("KMPR"
- Q:'$G(^%ZTSCH("LOGRSRC")) ; quit if RUM not turned on.
- ; call to RUM routine.
- D RU^%ZOSVKR($G(OPT),$G(TYPE),$G(STATUS))
- Q
- ;
- SETTRM(X) ;Turn on specified terminators.
- U $I:(TERMINATOR=X)
- Q 1
- ;
- DEVOK ;
- ;use lsof (list open files)
- ; given a device name in X
- ;INPUT: X=Device $I, X1=IOT -- X1 needed for resources
- ;OUTPUT: Y=0 if available, Y=job # if owned
- ; Y=-1 if device does not exists.
- ; return Y=0 if not owned, Y=$J of owning job, Y=999 if dev cycling
- ;
- I $G(X1)="RES" G RESOK^%ZIS6
- S Y=0
- Q ;Let ZIS deal with it.
- ;
- N %FILE S %FILE=$$TEMP_"zosv_devok_"_$J_".tmp"
- ZSYSTEM "/usr/sbin/lsof -F Pc "_X_" >"_%FILE
- N %I,%X,%Y S %I=$I
- O %FILE U %FILE
- F %Y=0:1 R %X:99 Q:%X="" Q:%X["lsof: status error" D
- . S %Y(%Y\2,$S($E(%X)="p":"PID",$E(%X)="c":"CMD",1:"?"))=$E(%X,2,$L(%X))
- U %I
- C %FILE:(DELETE)
- I %X["lsof: status error" S Y=-1 Q
- S %X="",Y=0
- F S %X=$O(%Y(%X)) Q:%X="" I %Y(%X,"CMD")="mumps" S Y=%Y(%X,"PID") Q
- Q
- ;
- DEVOPN ;List of Devices opened. Linux only
- ;Returns variable Y. Y=Devices owned separated by a comma
- N %I,%X,%Y
- ZSHOW "D":%Y
- S %I=0,Y="",%X=""
- F S %I=$O(%Y("D",%I)) Q:'%I S Y=Y_%X_$P(%Y("D",%I)," "),%X=","
- Q
- ;
- RETURN(%COMMAND) ; ** Private Entry Point: execute a shell command & return the resulting value **
- ; %COMMAND is the string value of the Linux command
- N %VALUE S %VALUE="" ; value to return
- N %FILE S %FILE=$$TEMP_"RET"_$J_".txt" ; temporary results file
- ZSYSTEM %COMMAND_" > "_%FILE ; execute command & save result
- O %FILE:(REWIND) U %FILE R:'$ZEOF %VALUE:99 C %FILE:(DELETE) ; fetch value & delete file
- ;
- QUIT %VALUE ; return value
- ;
- ;
- STRIPCR(%DIRECT) ; ** Private Entry Point: strip extraneous CR from end of lines of all
- ; routines in %DIRECTORY Linux directory
- ;
- ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[A-K]*.m"
- ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[L-S]*.m"
- ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[T-z]*.m"
- ZSYSTEM "perl -pi -e 's/\r\n$/\n/' "_%DIRECT_"[_]*.m"
- Q
- ;