| 1 | ZSY ;ISF/RWF - GT.M/VA system status display ;8/15/07 10:39
|
|---|
| 2 | ;;8.0;KERNEL;**349**;Jul 10, 1995;Build 2
|
|---|
| 3 | ; ;
|
|---|
| 4 | ; Copyright 1989,2001 Sanchez Computer Associates, Inc. ;
|
|---|
| 5 | ; ;
|
|---|
| 6 | ; This source code contains the intellectual property ;
|
|---|
| 7 | ; of its copyright holder(s), and is made available ;
|
|---|
| 8 | ; under a license. If you do not know the terms of ;
|
|---|
| 9 | ; the license, please stop and do not read further. ;
|
|---|
| 10 | ; ;
|
|---|
| 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 12 | ;GT.M/VA %SY utility - status display
|
|---|
| 13 | ;From the top just show by PID
|
|---|
| 14 | N IMAGE,MODE
|
|---|
| 15 | W !,"GT.M system status "
|
|---|
| 16 | L +^XUTL("XUSYS","COMMAND"):1 I '$T G LW
|
|---|
| 17 | S IMAGE=0,MODE=0 D WORK
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | QUERY N IMAGE,MODE,X
|
|---|
| 21 | L +^XUTL("XUSYS","COMMAND"):1 I '$T G LW
|
|---|
| 22 | S X=$$ASK W ! I X=-1 L -^XUTL("XUSYS","COMMAND") Q
|
|---|
| 23 | S IMAGE=$P(X,"~",2),MODE=+X D WORK
|
|---|
| 24 | Q
|
|---|
| 25 | IMAGE N IMAGE,MODE
|
|---|
| 26 | L +^XUTL("XUSYS","COMMAND"):1 I '$T G LW
|
|---|
| 27 | S IMAGE=1,MODE=0 D WORK
|
|---|
| 28 | Q
|
|---|
| 29 | WORK ;Main driver, Will release lock
|
|---|
| 30 | N NOPRIV,LOCK,PID,ACCESS,USERS,CTIME,GROUP,JTYPE,LTIME,MEMBER,PROCID
|
|---|
| 31 | N TNAME,UNAME,INAME,I,SORT,OLDPRIV,TAB
|
|---|
| 32 | N $ES,$ET,STATE,%PS,RTN,%OS,%T,SYSNAME,OLDINT,DONE
|
|---|
| 33 | ;Save $ZINTERRUPT, set new one
|
|---|
| 34 | S OLDINT=$ZINTERRUPT,$ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION) S DONE=1"
|
|---|
| 35 | ;%os = 1 for VMS, 0 = Linux.
|
|---|
| 36 | S %OS=$ZV["VMS",$ET="D ERR^ZSY"
|
|---|
| 37 | ;Clear old data
|
|---|
| 38 | S ^XUTL("XUSYS","COMMAND")="Status"
|
|---|
| 39 | S I=0 F S I=$O(^XUTL("XUSYS",I)) Q:'I K ^XUTL("XUSYS",I,"JE"),^("INTERUPT")
|
|---|
| 40 | S (LOCK,NOPRIV,USERS)=0
|
|---|
| 41 | U $P:CTRAP=$C(3)
|
|---|
| 42 | I %OS S %T=0 D I %T D EXIT Q
|
|---|
| 43 | . S OLDPRIV=$ZSETPRV("SYSLCK,GROUP,WORLD")
|
|---|
| 44 | . I '$ZPRIV("SYSLCK") S %T=1 W !,"You need SYSLCK privilege to run this program.",!
|
|---|
| 45 | . Q
|
|---|
| 46 | ;Go get the data
|
|---|
| 47 | I %OS D VMS
|
|---|
| 48 | I '%OS D UNIX
|
|---|
| 49 | ;Now show the results
|
|---|
| 50 | I USERS D
|
|---|
| 51 | . D HEADER,ISHOW:IMAGE,USHOW:'IMAGE
|
|---|
| 52 | . W !!,"Total ",USERS," user",$S(USERS>1:"s.",1:"."),!
|
|---|
| 53 | . Q
|
|---|
| 54 | E W !,"No current GT.M users.",!
|
|---|
| 55 | I NOPRIV W !,"Insufficient privileges to examine ",NOPRIV," process",$S(NOPRIV>1:"es.",1:"."),!
|
|---|
| 56 | EXIT ;
|
|---|
| 57 | L -^XUTL("XUSYS","COMMAND") ;Release lock and let others in
|
|---|
| 58 | I %OS S:$D(OLDPRIV) OLDPRIV=$ZSETPRV(OLDPRIV)
|
|---|
| 59 | I $L($G(OLDINT)) S $ZINTERRUPT=OLDINT
|
|---|
| 60 | U $P:CTRAP=""
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | ERR ;
|
|---|
| 64 | U $P W !,$P($ZS,",",2,99),!
|
|---|
| 65 | D EXIT
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | LW ;Lock wait
|
|---|
| 69 | W !,"Someone else is running the System status now."
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | VMS ;Collect VMS process info
|
|---|
| 73 | S $ET="D VERR^ZSY"
|
|---|
| 74 | S SYSNAME="SYSNAME"
|
|---|
| 75 | S ACCESS(0)="Detach",ACCESS(1)="Network",ACCESS(2)="Batch",ACCESS(3)="Local",ACCESS(4)="Dialup",ACCESS(5)="Remote"
|
|---|
| 76 | S STATE(5)="LEF",STATE(7)="HIB",STATE(12)="COM",STATE(14)="CUR"
|
|---|
| 77 | S LOCK=$ZLKID(0)
|
|---|
| 78 | I LOCK D F S LOCK=$ZLKID(1) Q:'LOCK D
|
|---|
| 79 | . I $EXTRACT($ZGETLKI(LOCK,"RESNAM"),1,6)="GTM$LM" S PID=$ZGETLKI(LOCK,"PID") D GETJOB(PID) W "."
|
|---|
| 80 | S USERS=USERS+NOPRIV
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | HEADER ;Display Header
|
|---|
| 84 | W # S ($X,$Y)=0
|
|---|
| 85 | S TAB(1)=9,TAB(2)=25,TAB(3)=29,TAB(4)=38,TAB(5)=57,TAB(6)=66
|
|---|
| 86 | W !,"GT.M Mumps users on ",$$DATETIME($H),!
|
|---|
| 87 | W !,"Proc. id",?TAB(1),"Proc. name",?TAB(2),"PS",?TAB(3),"Device",?TAB(4),"Routine",?TAB(5),"MODE",?TAB(6),"CPU time"
|
|---|
| 88 | W !,"--------",?TAB(1),"---------------",?TAB(2),"---",?TAB(3),"--------",?TAB(4),"--------",?TAB(5),"-------",?TAB(6)
|
|---|
| 89 | Q
|
|---|
| 90 | USHOW ;Display job info, sorted by pid
|
|---|
| 91 | N SI,X,EXIT,DEV
|
|---|
| 92 | S SI="",EXIT=0
|
|---|
| 93 | F S SI=$ORDER(SORT(SI)) Q:SI=""!EXIT F I=1:1:SORT(SI) D Q:EXIT
|
|---|
| 94 | . S X=SORT(SI,I)
|
|---|
| 95 | . S TNAME=$P(X,"~",4),PROCID=$P(X,"~",1)
|
|---|
| 96 | . S JTYPE=$P(X,"~",5),CTIME=$P(X,"~",6)
|
|---|
| 97 | . S LTIME=$P(X,"~",7),PS=$P(X,"~",3)
|
|---|
| 98 | . S PID=$P(X,"~",8),UNAME=$P(X,"~",2)
|
|---|
| 99 | . S RTN=$G(^XUTL("XUSYS",PID,"INTERRUPT"))
|
|---|
| 100 | . W !,PROCID,?TAB(1),UNAME,?TAB(2),$G(STATE(PS),PS),?TAB(3),TNAME,?TAB(4),RTN,?TAB(5),ACCESS(JTYPE),?TAB(6),$J(CTIME,6)
|
|---|
| 101 | . K DEV
|
|---|
| 102 | . F DI=1:1 Q:'$D(^XUTL("XUSYS",PID,"JE","D",DI)) S X=^(DI),X=$P(X,":")_":" I $TR(X,"_")'=TNAME S DEV(DI)=X
|
|---|
| 103 | . S DI=0 F S DI=$O(DEV(DI)) Q:DI'>0 W !,?TAB(3),$E(DEV(DI),1,79-$X)
|
|---|
| 104 | . I $Y>22 D WAIT
|
|---|
| 105 | Q
|
|---|
| 106 | ISHOW ;Show process sorted by IMAGE
|
|---|
| 107 | N SI,X
|
|---|
| 108 | S INAME="",EXIT=0
|
|---|
| 109 | F S INAME=$ORDER(SORT(INAME)) Q:INAME=""!EXIT D
|
|---|
| 110 | . W !,"IMAGE : ",INAME S SI=""
|
|---|
| 111 | . F S SI=$ORDER(SORT(INAME,SI)) Q:SI=""!EXIT F I=1:1:SORT(INAME,SI) D Q:EXIT
|
|---|
| 112 | . . S X=SORT(INAME,SI,I)
|
|---|
| 113 | . . S TNAME=$P(X,"~",4),PROCID=$P(X,"~",1)
|
|---|
| 114 | . . S PS=$P(X,"~",3),RTN=$P(X,"~",8)
|
|---|
| 115 | . . S JTYPE=$P(X,"~",5),CTIME=$P(X,"~",6)
|
|---|
| 116 | . . S LTIME=$P(X,"~",7),UNAME=$P(X,"~",2)
|
|---|
| 117 | . . S RTN=$G(^XUTL("XUSYS",RTN,"INTERRUPT"))
|
|---|
| 118 | . . W !,PROCID,?TAB(1),UNAME,?TAB(2),$G(STATE(PS),PS),?TAB(3),TNAME,?TAB(4),RTN,?TAB(5),ACCESS(JTYPE),?TAB(6),CTIME
|
|---|
| 119 | . . I $Y>22 D WAIT
|
|---|
| 120 | . W !
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | WAIT ;Page break
|
|---|
| 124 | N Y
|
|---|
| 125 | S Y=0 W !,"Press Return to continue '^' to stop: " R Y:300
|
|---|
| 126 | I $E(Y)="^" S EXIT=1
|
|---|
| 127 | E D HEADER
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | GETJOB(PID) ;Get data from a VMS job
|
|---|
| 131 | N NM,SI,$ET,$ES
|
|---|
| 132 | S $ET="G BLINDPID"
|
|---|
| 133 | S PROCID=$$FUNC^%DH(PID,8),TNAME=$ZGETJPI(PID,"TERMINAL")
|
|---|
| 134 | ZSYSTEM "@gtm$dist:mupip-intrpt.com "_PROCID ;"MUPIP INTRPT /ID="_procid
|
|---|
| 135 | S NM=$ZGETJPI(PID,"PRCNAM")
|
|---|
| 136 | S UNAME=$G(^XUTL("XUSYS",PID,"NM"),NM)
|
|---|
| 137 | S JTYPE=$ZGETJPI(PID,"JOBTYPE"),PS=$ZGETJPI(PID,"STATE")
|
|---|
| 138 | ;S RTN=PID ;$G(^XUTL("XUSYS",PID,"INTERRUPT"))
|
|---|
| 139 | S LTIME=$$DATETIME($ZGETJPI(PID,"LOGINTIM")),CTIME=$$CPUTIME($ZGETJPI(PID,"CPUTIM"))
|
|---|
| 140 | S SI=$S(MODE=1:CTIME,1:PID)
|
|---|
| 141 | I IMAGE D
|
|---|
| 142 | . S INAME=$ZGETJPI(PID,"IMAGNAME"),I=$GET(SORT(INAME,SI))+1,SORT(INAME,SI)=I
|
|---|
| 143 | . S SORT(INAME,SI,I)=PROCID_"~"_UNAME_"~"_PS_"~"_TNAME_"~"_JTYPE_"~"_CTIME_"~"_LTIME_"~"_PID_"~"_INAME
|
|---|
| 144 | E S I=$GET(SORT(SI))+1,SORT(SI)=I,SORT(SI,I)=PROCID_"~"_UNAME_"~"_PS_"~"_TNAME_"~"_JTYPE_"~"_CTIME_"~"_LTIME_"~"_PID
|
|---|
| 145 | S USERS=USERS+1
|
|---|
| 146 | Q
|
|---|
| 147 | ;
|
|---|
| 148 | DATETIME(HOROLOG) ;
|
|---|
| 149 | Q $ZDATE(HOROLOG,"DD-MON-YY 24:60:SS","Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec")
|
|---|
| 150 | ;
|
|---|
| 151 | CPUTIME(S) ;
|
|---|
| 152 | N T,S,M,H,D
|
|---|
| 153 | S T=S#100,S=S\100 S:$L(T)=1 T="0"_T
|
|---|
| 154 | S S=S#60,S=S\60 S:$L(S)=1 S="0"_S
|
|---|
| 155 | S M=S#60,S=S\60 S:$L(M)=1 M="0"_M
|
|---|
| 156 | S H=S#24,D=S\24 S:$L(H)=1 H="0"_H
|
|---|
| 157 | Q D_" "_H_":"_M_":"_S_"."_T
|
|---|
| 158 | ;
|
|---|
| 159 | BLINDPID ;
|
|---|
| 160 | N ZE S ZE=$ZS,$EC=""
|
|---|
| 161 | I ZE["NOPRIV" S NOPRIV=NOPRIV+1
|
|---|
| 162 | Q
|
|---|
| 163 | VERR W !,"lock = ",LOCK,!
|
|---|
| 164 | W !,$P(ZE,",",2,99),! U $P:CTRAP="" S:$D(OLDPRIV) OLDPRIV=$ZSETPRV(OLDPRIV)
|
|---|
| 165 | Q
|
|---|
| 166 | ASK() ;Ask sort item
|
|---|
| 167 | N RES,X,GROUP
|
|---|
| 168 | S RES=0,GROUP=2
|
|---|
| 169 | W !,"1 pid",!,"2 cpu time",!,"3 IMAGE/pid",!,"4 IMAGE/cpu"
|
|---|
| 170 | F R !,"1// ",X:600 S:X="" X=1 Q:X["^" Q:(X>0)&(X<5) W " not valid"
|
|---|
| 171 | Q:X["^" -1
|
|---|
| 172 | S X=X-1,RES=(X#GROUP)_"~"_(X\GROUP)
|
|---|
| 173 | Q RES
|
|---|
| 174 | ;
|
|---|
| 175 | UNIX ;PUG/TOAD - Kernel System Status Report for GT.M
|
|---|
| 176 | ;S $ZT="ZG "_$ZL_":UERR^ZSY"
|
|---|
| 177 | N %FILE,%LINE,%TEXT,%I,U,%J,STATE,$ET,$ES
|
|---|
| 178 | S $ET="D UERR^ZSY"
|
|---|
| 179 | S %FILE="/tmp/_gtm_sy_"_$J_".tmp"
|
|---|
| 180 | ;ZSYSTEM "ps ef -C mumps>"_%FILE
|
|---|
| 181 | ZSYSTEM "ps eo pid,tty,stat,time,cmd -C mumps>"_%FILE
|
|---|
| 182 | S %I=$I,U="^"
|
|---|
| 183 | O %FILE:(readonly)
|
|---|
| 184 | ;
|
|---|
| 185 | ; Get lines of text from temp file
|
|---|
| 186 | U %FILE F R %TEXT Q:%TEXT="" D
|
|---|
| 187 | . S %LINE=$$VPE(%TEXT," ",U) ; parse each line of the ps output
|
|---|
| 188 | . Q:$P(%LINE,U)="PID" ; header line
|
|---|
| 189 | . D JOBSET
|
|---|
| 190 | ;
|
|---|
| 191 | U %I C %FILE:DELETE
|
|---|
| 192 | Q
|
|---|
| 193 | ;
|
|---|
| 194 | UERR ;Linux Error
|
|---|
| 195 | N ZE S ZE=$ZS,$EC="" U $P
|
|---|
| 196 | ZSHOW "*"
|
|---|
| 197 | Q ;halt
|
|---|
| 198 | ;
|
|---|
| 199 | JOBSET ;Get data from a Linux job
|
|---|
| 200 | S (IMAGE,INAME,UNAME,PS,TNAME,JTYPE,CTIME,LTIME,RTN)=""
|
|---|
| 201 | S (%J,PID,PROCID)=$P(%LINE,U)
|
|---|
| 202 | S TNAME=$P(%LINE,U,2) S:TNAME="?" TNAME="" ; TTY, ? if none
|
|---|
| 203 | S PS=$P(%LINE,U,3) ; process STATE
|
|---|
| 204 | S PS=$S(PS="D":"lef",PS="R":"com",PS="S":"hib",1:PS)
|
|---|
| 205 | S CTIME=$P(%LINE,U,4) ;cpu time
|
|---|
| 206 | S JTYPE=$P(%LINE,U,6),ACCESS(JTYPE)=JTYPE
|
|---|
| 207 | ZSYSTEM "mupip intrpt "_%J
|
|---|
| 208 | S UNAME=$G(^XUTL("XUSYS",%J,"NM"))
|
|---|
| 209 | S RTN="" ; Routine, get at display time
|
|---|
| 210 | S SI=$S(MODE=0:PID,MODE=1:CTIME,1:PID)
|
|---|
| 211 | I IMAGE D
|
|---|
| 212 | . S INAME="mumps",I=$GET(SORT(INAME,SI))+1,SORT(INAME,SI)=I
|
|---|
| 213 | . S SORT(INAME,SI,I)=PROCID_"~"_UNAME_"~"_PS_"~"_TNAME_"~"_JTYPE_"~"_CTIME_"~"_LTIME_"~"_PID_"~"_INAME
|
|---|
| 214 | E S I=$GET(SORT(SI))+1,SORT(SI)=I,SORT(SI,I)=PROCID_"~"_UNAME_"~"_PS_"~"_TNAME_"~"_JTYPE_"~"_CTIME_"~"_LTIME_"~"_PID
|
|---|
| 215 | S USERS=USERS+1
|
|---|
| 216 | Q
|
|---|
| 217 | ;
|
|---|
| 218 | VPE(%OLDSTR,%OLDDEL,%NEWDEL) ; $PIECE extract based on variable length delimiter
|
|---|
| 219 | N %LEN,%PIECE,%NEWSTR
|
|---|
| 220 | S %STRING=$G(%STRING)
|
|---|
| 221 | S %OLDDEL=$G(%OLDDEL) I %OLDDEL="" S %OLDDEL=" "
|
|---|
| 222 | S %LEN=$L(%OLDDEL)
|
|---|
| 223 | ; each %OLDDEL-sized chunk of %OLDSTR that might be delimiter
|
|---|
| 224 | S %NEWDEL=$G(%NEWDEL) I %NEWDEL="" S %NEWDEL="^"
|
|---|
| 225 | ; each piece of the old string
|
|---|
| 226 | S %NEWSTR="" ; new reformatted string to return
|
|---|
| 227 | F Q:%OLDSTR="" D
|
|---|
| 228 | . S %PIECE=$P(%OLDSTR,%OLDDEL)
|
|---|
| 229 | . S $P(%OLDSTR,%OLDDEL)=""
|
|---|
| 230 | . S %NEWSTR=%NEWSTR_$S(%NEWSTR="":"",1:%NEWDEL)_%PIECE
|
|---|
| 231 | . F Q:%OLDDEL'=$E(%OLDSTR,1,%LEN) S $E(%OLDSTR,1,%LEN)=""
|
|---|
| 232 | Q %NEWSTR
|
|---|
| 233 | ;
|
|---|
| 234 | INTRPT ;List jobs that set INTRUPT.
|
|---|
| 235 | N J
|
|---|
| 236 | S J=0
|
|---|
| 237 | F S J=$O(^XUTL("XUSYS",J)) Q:J'>0 S X=$G(^XUTL("XUSYS",J,"INTERRUPT")) I $L(X) W !,J,?10,X
|
|---|
| 238 | Q
|
|---|
