******************************************************************************** * AUTHOR - Connie R. Minnick * * Academic Computing Center * * James Madison University * * Harrisonburg, VA 22807 * * * * DATE - April 1, 1987 * ******************************************************************************** ******************************************************************************** * This is a program designed to enable an operator or privileged user to * * affect another process on the system without having to look up and use * * the process PID. The only requirement to execute this program is that * * VAX FMS must be installed. * * * * FMS is used to set up a screen where the current processes will be * * displayed. The operator may then use the arrow keys to "scroll" through * * the processes and perform certain functions on the selected process. * * * * The process data information includes: * * USERNAME TERMINAL * * PROCESS NAME ACCUMULATED CPU TIME * * PROCESS STATE PROCESS AGE or CONNECT TIME * * PROCESS TYPE * * * * The functions currently implemented are: * * ABORT ==> Aborts the selected process * * MONITOR ==> Monitors the selected process with SHOW PROC/CONTINUOUS * * TOPCPU ==> Displays the TOPCPU processes on the system * * * * Other functions such as SUSPEND, RESUME and CHANGE PRIORITY can easily * * be built into this program as well. * * * * By default, all critical system processes will be filtered out and not * * displayed. This will avoid potentially aborting such processes. There * * are two arrays used for this purpose that should be modified for each * * application. One array lists the critical processes to be filtered * * and the other lists usernames for which you want to override the * * filtering procedure (i.e., users with SYSPRIV). * ******************************************************************************** ******************************************************************************** * SYSTEM SERVICES: * * SYS$GETJPIW - Extracts the username for the current process * ******************************************************************************** ******************************************************************************** * LIBRARY ROUTINES: * * LIB$SPAWN - Spawns a subprocess to execute the given command * ******************************************************************************** ******************************************************************************** * SUBROUTINES: * * ABORT - Aborts the selected process (not batch) * * ABORTBATCH - Aborts the selected process (batch) and sends a log file to * * SYS$PRINT * * BOLD_REVERSE_ON - Turns on field video attributes BOLD and REVERSE * * CLS - Clears the screen * * DEFINE_KEYS - Redefines some of the functions of the FMS keyboard * * DELTA_TIME - Calculates the difference between two ASCII times * * NEW_PAGE - Handles screen control during the display of a new page * * POINTERS_OFF - Handles video attributes in turning pointers to the * * selected process off * * POINTERS_ON - Handles video attributes in turning pointers to the * * selected process on * * RESAMPLE - Handles the actual data gathering for all system processes * * TIMCVT - Converts a 32-bit absolute time to an ASCII time * * VIDEO_OFF - Turns off all field video attributes * * VIDEO_ON - Turns on field video attribute REVERSE * * WAIT - Waits a specified amount of seconds before proceeding * ******************************************************************************** ******************************************************************************** * INTEGER VARIABLES: * * CH - Array subscript of the selected process * * CTRLB - FMS terminator code for ^B (page backward) * * CTRLF - FMS terminator code for ^F (page forward) * * CTRLR - FMS terminator code for ^R (Resample processes) * * CTRLZ - FMS terminator code for ^Z (Exit) * * CURSORS - Statement label for beginning of cursor control handling * * DOWN - FMS terminator code for the down-arrow * * ENTER - FMS terminator code for (select) * * FINISH - Statement label for Exiting program * * FUNCTION - Statement label for beginning of function handling * * LASTNDX - Last field index possible for last page of data * * MAXPAGE - Maximum page number for data * * NDX - Field index number for the currently selected process * * NEWPAGE - Statement label for beginning of new page handling * * NLINES - Number of data display lines on the form * * NNOFILT - Number of usernames that may override the filtering process * * NSCREEN - FMS terminator code for Next Screen key on a VT220 terminal * * PAGE - Current page of data * * PAGEB - FMS terminator code for up-arrow (page back) * * PAGEF - FMS terminator code for down-arrow (page forward) * * PID - Process ID number returned from SYS$GETJPIW * * PSCREEN - FMS terminator code for Previous Screen key on a VT220 terminal * * RESAMP - Statement label for beginning of resampling current processes * * SIZE - Approximation for the size of the FMS form * * STATUS - Status return from the System Service Call * * TERM - FMS terminator value returned from FMS GET * * UNAME_LEN - Length of username returned by SYS$GETJPIW * * UP - FMS terminator code for the up-arrow * ******************************************************************************** ******************************************************************************** * CHARACTER VARIABLES: * * FUN - Value of Function the operator entered * * NOFILTER - Array of usernames that override filtering procedure * * RIGHT - Value of verification choice entered by operator * * SPAWNSTR - Full Spawn command to be executed * * STRING - Basic command for Spawn * * TCA - Terminal Control Area used by FMS * * UNAME - Username returned by SYS$GETJPIW * * VAL - Value of Choice the operator entered * * VERIFY - String displayed for verification * * WORK - Workspace used by FMS * ******************************************************************************** ******************************************************************************** * LOGICAL VARIABLES * * FIRST - Flag for the first time the screen is displayed * * SYSUSER - Flag for overriding the filtering procedure * ******************************************************************************** ******************************************************************************** * DATA STRUCTURES: * * /JPI/ - Structure read by SYS$GETJPIW for requested information * * /DATA/ - Structure used to store process data * ******************************************************************************** ******************************************************************************** * RECORDS: * * ULIST - Array of 2, of type /JPI/ * * LINE - Array of 150, of type /DATA/ * ******************************************************************************** PROGRAM KILL COMMON /INFO/ TCA,WORK,NDX COMMON /RESAMPLE/ SYSUSER,LINE,MAXPAGE,LASTNDX,NLINES,PAGE INTEGER SYS$GETJPIW,TERM,SIZE,STATUS,PID,FINISH,RESAMP INTEGER NDX,LASTNDX,MAXPAGE,PAGE,CH,UNAME_LEN,CTRLR INTEGER DOWN,UP,ENTER,CTRLZ,CTRLB,CTRLF,FUNCTION,NEWPAGE INTEGER NSCREEN,PSCREEN,PAGEF,PAGEB,NNOFILT,NLINES,CURSORS CHARACTER TCA*12,WORK*12,UNAME*12,SPAWNSTR*29,FUN*1,STRING*21 CHARACTER VAL*1,VERIFY*21,NOFILTER(30)*12,RIGHT*1 LOGICAL SYSUSER,FIRST INCLUDE '($FDVDEF)' INCLUDE '($SSDEF)' INCLUDE '($JPIDEF)' STRUCTURE /JPI/ UNION MAP INTEGER*2 LEN,COD INTEGER BUF,RET END MAP MAP INTEGER ENDLIST END MAP END UNION END STRUCTURE STRUCTURE /DATA/ UNION MAP CHARACTER*12 UNAME CHARACTER*1 S1 CHARACTER*15 PNAME CHARACTER*1 S2 CHARACTER*5 TERM CHARACTER*2 S3 CHARACTER*1 TYPE CHARACTER*3 S4 CHARACTER*5 STATE CHARACTER*1 S5 CHARACTER*14 CPU CHARACTER*1 S6 CHARACTER*14 CONNECT END MAP MAP CHARACTER*75 WHOLE END MAP END UNION CHARACTER*8 PID END STRUCTURE RECORD /DATA/ LINE(150) RECORD /JPI/ ULIST(2) ***** Initialize ULIST for requested information ULIST(1).LEN = 12 ULIST(1).COD = JPI$_USERNAME ULIST(1).BUF = %LOC(UNAME) ULIST(1).RET = %LOC(UNAME_LEN) ULIST(2).ENDLIST = 0 ***** Initialize NOFILTER array for those who will override the filtering procedure NOFILTER(1) = 'ACC_MIKE' NOFILTER(2) = 'ACC_CONNIE' NOFILTER(3) = 'OPER_MGR' NOFILTER(4) = 'ACC_RITA' NOFILTER(5) = 'ACC_STIN' NOFILTER(6) = 'ACC_SUE' NOFILTER(7) = 'SYSTEM' ***** Initialize number of users that may override the filtering procedure NNOFILT = 7 ***** Blank out remaining subscripts of NOFILTER array DO I = NNOFILT+1,20 NOFILTER(I) = ' ' ENDDO ***** Initialize the FMS terminator codes ENTER = FDV$K_FT_NTR DOWN = FDV$K_AR_DOWN UP = FDV$K_AR_UP PAGEB = 227 PAGEF = 228 PSCREEN = 37 NSCREEN = 38 CTRLR = 1042 CTRLZ = 1050 CTRLB = 1026 CTRLF = 1030 ***** Initialize the maximum number of lines on the form NLINES = 15 ***** Approximate the size of the FMS form SIZE = 500 ***** Initialize the command for LIB$SPAWN STRING = 'SHOW PROCESS/CONT/ID=' ***** Assign Statement labels to control variables ASSIGN 10 TO RESAMP ASSIGN 55 TO NEWPAGE ASSIGN 60 TO CURSORS ASSIGN 100 TO FUNCTION ASSIGN 1000 TO FINISH ***** Set up FMS work areas CALL FDV$ATERM (TCA,12,2) CALL FDV$AWKSP (WORK,SIZE) CALL FDV$SWKSP (WORK) CALL FDV$LOAD ('KILL') ***** Redefine the necessary keys for FMS CALL DEFINE_KEYS ***** Extract the current user, and determine of SYSUSER STATUS = SS$_NORMAL STATUS = SYS$GETJPIW (,,,ULIST,,,) SYSUSER = .FALSE. DO I = 1,NNOFILT IF (UNAME(1:UNAME_LEN) .EQ. NOFILTER(I)) SYSUSER = .TRUE. ENDDO ***** Initialize First display flag FIRST = .TRUE. ***** Call routine to gather information on all system processes 10 CALL RESAMPLE ***** Call routine to handle displaying a new page 55 CALL NEW_PAGE (FIRST) ***** Cursor control and Performance of chosen functions 60 CALL POINTERS_ON CALL FDV$GET (VAL,TERM,'CH') IF (TERM .EQ. CTRLZ) THEN GOTO FINISH ELSE IF (TERM .EQ. CTRLR) THEN CALL POINTERS_OFF CALL FDV$PUT (' ','CH') GOTO RESAMP ELSE IF (TERM .EQ. CTRLB .OR. TERM .EQ. PAGEB * .OR. TERM .EQ. PSCREEN) THEN IF (PAGE .EQ. 1) THEN CALL FDV$PUTL (' First page, cannot page backward') CALL FDV$BELL CALL WAIT(1) GOTO CURSORS ELSE CALL POINTERS_OFF PAGE = PAGE - 1 GOTO NEWPAGE ENDIF ELSE IF (TERM .EQ. CTRLF .OR. TERM .EQ. PAGEF * .OR. TERM .EQ. NSCREEN) THEN IF (PAGE .EQ. MAXPAGE) THEN CALL FDV$PUTL (' Last page, cannot page forward') CALL FDV$BELL CALL WAIT(1) GOTO CURSORS ELSE CALL POINTERS_OFF PAGE = PAGE + 1 GOTO NEWPAGE ENDIF ELSE IF (TERM .EQ. DOWN) THEN IF (PAGE .NE. MAXPAGE) THEN CALL POINTERS_OFF IF (NDX .NE. NLINES) THEN NDX = NDX + 1 GOTO CURSORS ELSE NDX = 1 PAGE = PAGE+ 1 GOTO NEWPAGE ENDIF ELSE IF (NDX .NE. LASTNDX) THEN CALL POINTERS_OFF NDX = NDX + 1 ELSE CALL FDV$PUTL (' CANNOT MOVE DOWN') CALL FDV$BELL CALL WAIT(1) ENDIF GOTO CURSORS ENDIF ELSE IF (TERM .EQ. UP) THEN IF (PAGE .NE. 1) THEN CALL POINTERS_OFF IF (NDX .NE. 1) THEN NDX = NDX - 1 GOTO CURSORS ELSE NDX = NLINES PAGE = PAGE - 1 GOTO NEWPAGE ENDIF ELSE IF (NDX .NE. 1) THEN CALL POINTERS_OFF NDX = NDX - 1 ELSE CALL FDV$PUTL (' CANNOT MOVE UP') CALL FDV$BELL CALL WAIT(1) ENDIF GOTO CURSORS ENDIF ENDIF IF (VAL .EQ. 'Q') GOTO FINISH CH = ((PAGE-1)*NLINES)+NDX IF (VAL .EQ. 'A') THEN CALL VIDEO_ON ('BIG') VERIFY = 'ABORT process ? (Y/N)' CALL FDV$PUT (VERIFY,'VERIFY') CALL FDV$GET (RIGHT,TERM,'RIGHT') IF (TERM .EQ. CTRLZ) GOTO FINISH IF (TERM .EQ. CTRLR) THEN CALL POINTERS_OFF CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') GOTO RESAMP ENDIF IF (RIGHT .EQ. 'Y') THEN IF (LINE(CH).TYPE .NE. 'B') THEN CALL ABORT (CH,LINE) ELSE READ (LINE(CH).PID,'(Z8)') PID CALL ABORTBATCH (CH,LINE,PID) ENDIF CALL VIDEO_OFF ('BIG') CALL POINTERS_OFF CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','CH') CALL FDV$PUT (' ','RIGHT') GOTO RESAMP ELSE CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') CALL FDV$PUT (' ','CH') GOTO CURSORS ENDIF ELSE IF (VAL .EQ. 'S') THEN SPAWNSTR = STRING//LINE(CH).PID CALL FDV$NDISP CALL CLS STATUS = LIB$SPAWN (SPAWNSTR) CALL CLS IF (STATUS .NE. SS$_NORMAL) THEN PRINT*, ' UNABLE TO MONITOR PROCESS' CALL WAIT(3) CALL CLS ENDIF CALL FDV$PUT (' ','CH') CALL FDV$DISPW GOTO CURSORS ELSE IF (VAL .EQ. 'T') THEN CALL FDV$NDISP CALL CLS CALL LIB$SPAWN ('MONITOR PROCESS/TOPCPU') CALL CLS CALL FDV$PUT (' ','CH') CALL FDV$DISPW GOTO CURSORS ELSE IF (VAL .EQ. ' ') THEN CALL VIDEO_ON ('BIG') VERIFY = ' Enter Function:' CALL FDV$PUT (VERIFY,'VERIFY') 100 CALL FDV$GET (FUN,TERM,'RIGHT') IF (TERM .EQ. CTRLZ) GOTO FINISH IF (TERM .EQ. CTRLR) THEN CALL POINTERS_OFF CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') GOTO RESAMP ENDIF IF (FUN .EQ. ' ') THEN CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') GOTO CURSORS ELSE IF (FUN .EQ. 'Q') THEN GOTO FINISH ELSE IF (FUN .EQ. 'A') THEN VERIFY = 'ABORT process ? (Y/N)' CALL FDV$PUT (VERIFY,'VERIFY') CALL FDV$PUT (' ','RIGHT') CALL FDV$GET (RIGHT,TERM,'RIGHT') IF (TERM .EQ. CTRLZ) GOTO FINISH IF (TERM .EQ. CTRLR) THEN CALL POINTERS_OFF CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') GOTO RESAMP ENDIF IF (RIGHT .EQ. 'Y') THEN IF (LINE(CH).TYPE .NE. 'B') THEN CALL ABORT (CH,LINE) ELSE READ (LINE(CH).PID,'(Z8)') PID CALL ABORTBATCH (CH,LINE,PID) ENDIF CALL VIDEO_OFF ('BIG') CALL POINTERS_OFF CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') GOTO RESAMP ELSE CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') GOTO CURSORS ENDIF ELSE IF (FUN .EQ. 'S') THEN SPAWNSTR = STRING//LINE(CH).PID CALL FDV$NDISP CALL CLS STATUS = LIB$SPAWN (SPAWNSTR) CALL CLS IF (STATUS .NE. SS$_NORMAL) THEN PRINT*, ' UNABLE TO MONITOR PROCESS' CALL WAIT(3) CALL CLS ENDIF CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') CALL FDV$DISPW GOTO CURSORS ELSE IF (FUN .EQ. 'T') THEN CALL FDV$NDISP CALL CLS CALL LIB$SPAWN ('MONITOR PROCESS/TOPCPU') CALL CLS CALL VIDEO_OFF ('BIG') CALL FDV$PUT (' ','VERIFY') CALL FDV$PUT (' ','RIGHT') CALL FDV$DISPW GOTO CURSORS ELSE CALL FDV$PUTL (' That function is not currently availble') CALL FDV$BELL CALL WAIT(1) CALL FDV$PUT (' ','RIGHT') GOTO FUNCTION ENDIF ELSE CALL FDV$PUTL (' That function is not currently available') CALL FDV$BELL CALL WAIT(1) CALL FDV$PUT (' ','CH') GOTO CURSORS ENDIF 1000 CALL FDV$DWKSP (WORK) CALL FDV$DTERM (TCA) CALL CLS END ******************************************************************************** * This subroutine aborts the selected process ( if it is NOT a batch process) * * by using the system service routine SYS$DELPRC. * ******************************************************************************** SUBROUTINE ABORT (CUR,LINE) COMMON /INFO/ TCA,WORK,NDX INTEGER CUR,SYS$DELPRC,PID,STATUS,NDX CHARACTER TCA*12,PRCNAM*15,WORK*12 INCLUDE '($FDVDEF)' STRUCTURE /DATA/ UNION MAP CHARACTER*12 UNAME CHARACTER*1 S1 CHARACTER*15 PNAME CHARACTER*1 S2 CHARACTER*5 TERM CHARACTER*2 S3 CHARACTER*1 TYPE CHARACTER*3 S4 CHARACTER*5 STATE CHARACTER*1 S5 CHARACTER*14 CPU CHARACTER*1 S6 CHARACTER*14 CONNECT END MAP MAP CHARACTER*75 WHOLE END MAP END UNION CHARACTER*8 PID END STRUCTURE RECORD /DATA/ LINE(150) READ (LINE(CUR).PID,'(Z8)') PID STATUS = SYS$DELPRC (PID,) CALL FDV$PUTL ('Process Aborted') CALL FDV$SIGOP CALL WAIT(1) RETURN END ******************************************************************************** * This subroutine aborts a batch process that was selected by searching the * * batch queues and deleting that process. * ******************************************************************************** SUBROUTINE ABORTBATCH (CUR,LINE,PID) COMMON /INFO/ TCA,WORK,NDX INTEGER CUR,SYS$GETQUIW,JOBPID,STATUS_Q,STATUS_J,ENTRY,NDX INTEGER PID,SEARCH_FLAGS,SNLEN,QNAME_LEN,QFLAGS,JNL,NOABORT INTEGER WRITING CHARACTER TCA*12,WORK*12,SN*31,QNAME*31,CHENTRY*4,STRING*60 CHARACTER JNAME*39 INCLUDE '($FDVDEF)' INCLUDE '($SSDEF)' INCLUDE '($QUIDEF)' STRUCTURE /DATA/ UNION MAP CHARACTER*12 UNAME CHARACTER*1 S1 CHARACTER*15 PNAME CHARACTER*1 S2 CHARACTER*5 TERM CHARACTER*2 S3 CHARACTER*1 TYPE CHARACTER*3 S4 CHARACTER*5 STATE CHARACTER*1 S5 CHARACTER*14 CPU CHARACTER*1 S6 CHARACTER*14 CONNECT END MAP MAP CHARACTER*75 WHOLE END MAP END UNION CHARACTER*8 PID END STRUCTURE STRUCTURE /ITEMS/ UNION MAP INTEGER*2 LEN,COD INTEGER BUF,RET END MAP MAP INTEGER ENDLIST END MAP END UNION END STRUCTURE STRUCTURE /IOSBLK/ INTEGER STS,ZEROED END STRUCTURE RECORD /DATA/ LINE(150) RECORD /ITEMS/ Q(5),J(5) RECORD /IOSBLK/ IOSB SNLEN = 31 SN = '*' SEARCH_FLAGS = (QUI$M_SEARCH_BATCH .OR. * QUI$M_SEARCH_WILDCARD .OR. * QUI$M_SEARCH_SYMBIONT .OR. * QUI$M_SEARCH_ALL_JOBS) Q(1).LEN = SNLEN Q(1).COD = QUI$_SEARCH_NAME Q(1).BUF = %LOC(SN) Q(1).RET = 0 Q(2).LEN = 4 Q(2).COD = QUI$_SEARCH_FLAGS Q(2).BUF = %LOC(SEARCH_FLAGS) Q(2).RET = 0 Q(3).LEN = 31 Q(3).COD = QUI$_QUEUE_NAME Q(3).BUF = %LOC(QNAME) Q(3).RET = %LOC(QNAME_LEN) Q(4).LEN = 4 Q(4).COD = QUI$_QUEUE_FLAGS Q(4).BUF = %LOC(QFLAGS) Q(4).RET = 0 Q(5).ENDLIST = 0 J(1).LEN = 4 J(1).COD = QUI$_SEARCH_FLAGS J(1).BUF = %LOC(SEARCH_FLAGS) J(1).RET = 0 J(2).LEN = 4 J(2).COD = QUI$_ENTRY_NUMBER J(2).BUF = %LOC(ENTRY) J(2).RET = 0 J(3).LEN = 39 J(3).COD = QUI$_JOB_NAME J(3).BUF = %LOC(JNAME) J(3).RET = %LOC(JNL) J(4).LEN = 4 J(4).COD = QUI$_JOB_PID J(4).BUF = %LOC(JOBPID) J(4).RET = 0 J(5).ENDLIST = 0 ASSIGN 100 TO WRITING ASSIGN 1000 TO NOABORT STATUS_Q = SYS$GETQUIW (,%VAL(QUI$_CANCEL_OPERATION),,,,,) DO WHILE (STATUS_Q) STATUS_Q = SYS$GETQUIW (,%VAL(QUI$_DISPLAY_QUEUE),,Q,IOSB,,) IF (STATUS_Q) STATUS_Q = IOSB.STS STATUS_J = 1 DO WHILE (STATUS_Q .AND. STATUS_J) STATUS_J = SYS$GETQUIW (,%VAL(QUI$_DISPLAY_JOB),,J,IOSB,,) IF (STATUS_J) STATUS_J = IOSB.STS IF (STATUS_J) THEN IF (QFLAGS .AND. QUI$M_QUEUE_BATCH) THEN IF (JOBPID .EQ. PID) THEN GOTO WRITING ENDIF ENDIF ENDIF ENDDO ENDDO GOTO NOABORT 100 WRITE (CHENTRY,'(I4)') ENTRY STRING = 'DELETE/ENTRY='//CHENTRY//' '//QNAME CALL LIB$SPAWN (STRING) CALL FDV$PUTL ('Process Aborted') CALL FDV$SIGOP CALL WAIT(1) RETURN 1000 CALL FDV$PUTL ('UNABLE TO ABORT PROCESS') CALL FDV$SIGOP CALL FDV$SIGOP CALL WAIT(2) RETURN END ******************************************************************************** * This subroutine converts a 32-bit absolute time into an ASCII string. * ******************************************************************************** SUBROUTINE TIMCVT (TIM,TSTRING) IMPLICIT INTEGER (A-Z) INTEGER HSC, TIM, HR, MIN, SEC, DAY CHARACTER TSTRING*16 HSC = TIM - ((TIM/100)*100) TIM = TIM/100 DAY = TIM/86400 TIM = TIM - DAY*86400 HR = TIM/3600 TIM = TIM - HR*3600 MIN = TIM/60 TIM = TIM - MIN*60 SEC = TIM WRITE (TSTRING,'(I4,1X,I2,1H:,I2,1H:,I2,1H.,I2)',ERR=10) * DAY,HR,MIN,SEC,HSC 10 CONTINUE DO I = 6,16 IF (TSTRING(I:I) .EQ. ' ') TSTRING(I:I) = '0' ENDDO RETURN END ******************************************************************************** * This subroutine calculates the difference between two ASCII times and * * returns both the difference in time as well as a status variable signifying * * which time was the greatest. * ******************************************************************************** SUBROUTINE DELTA_TIME (ABS1,ABS2,DELTA,STATUS) CHARACTER ABS1*23,ABS2*23,DELTA*16 INTEGER STATUS,BTIM1(2),BTIM2(2),BDELTA(2) INTEGER SYS$BINTIM,SYS$NUMTIM,SYS$ASCTIM STRUCTURE /TSTRUCT/ INTEGER*2 YR,MON,DAY,HR,MIN,SEC,HSEC END STRUCTURE RECORD /TSTRUCT/ TBUFF(3) STATUS = SYS$BINTIM (ABS1,BTIM1) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) STATUS = SYS$BINTIM (ABS2,BTIM2) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) CALL LIB$SUBX (BTIM1,BTIM2,BDELTA) IF (BDELTA(2) .EQ. 0 .AND. BDELTA(1) .EQ. 0) THEN DELTA = '0 00:00:00.00' STATUS = 0 GOTO 150 ELSE IF (BDELTA(2) .GE. 0) THEN BDELTA(2) = BDELTA(2)*(-1) - 1 BDELTA(1) = BDELTA(1)*(-1) ENDIF STATUS = SYS$ASCTIM (,DELTA,BDELTA,) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) STATUS = SYS$NUMTIM (TBUFF(1),BTIM1) STATUS = SYS$NUMTIM (TBUFF(2),BTIM2) STATUS = SYS$NUMTIM (TBUFF(3),BDELTA) STATUS = 0 IF (TBUFF(1).YR - TBUFF(2).YR) 200,11,210 11 IF (TBUFF(1).MON - TBUFF(2).MON) 200,12,210 12 IF (TBUFF(1).DAY - TBUFF(2).DAY) 200,13,210 13 IF (TBUFF(1).HR - TBUFF(2).HR) 200,14,210 14 IF (TBUFF(1).MIN - TBUFF(2).MIN) 200,15,210 15 IF (TBUFF(1).SEC - TBUFF(2).SEC) 200,16,210 16 IF (TBUFF(1).HSEC - TBUFF(2).HSEC) 200,17,210 17 CONTINUE 150 RETURN 200 CONTINUE STATUS = -1 RETURN 210 CONTINUE STATUS = 1 RETURN END ******************************************************************************** * This subroutine clears the screen. * ******************************************************************************** SUBROUTINE CLS WRITE (6,'(1X,A)') CHAR(27)//'[H'//CHAR(27)//'[2J' RETURN END ******************************************************************************** * This subroutine causes the current process to pause for the specified * * amount of seconds before proceeding. * ******************************************************************************** SUBROUTINE WAIT (IWTIME) CHARACTER WTIME*24 INTEGER IWTIME, J, H, M, S INTEGER SYS$SCHDWK, SYS$HIBER, SYS$BINTIM INTEGER STATUS, WAITTIME(2) J = IWTIME H = J/3600 M = (J-H)/60 S = J-(H*3600+M*60) WTIME = '0000 00:00:00.00' WRITE (WTIME(6:7),'(I2)') H WRITE (WTIME(9:10),'(I2)') M WRITE (WTIME(12:13),'(I2)') S STATUS = SYS$BINTIM(WTIME, WAITTIME) IF (.NOT. STATUS) RETURN STATUS = SYS$SCHDWK(,,WAITTIME,) IF (.NOT. STATUS) RETURN STATUS = SYS$HIBER() RETURN END ******************************************************************************** * This subroutine redefines several keys for the FMS environment. * ******************************************************************************** SUBROUTINE DEFINE_KEYS COMMON /INFO/ TCA,WORK,NDX INTEGER NDX CHARACTER*12 TCA,WORK INCLUDE '($FDVDEF)' INTEGER*2 KEYTABLE(10) /FDV$K_KF_SBK, FDV$K_KF_NONE, * FDV$K_KF_SFW, FDV$K_KF_NONE, * FDV$K_KF_XBK, FDV$K_KF_NONE, * FDV$K_KF_XFW, FDV$K_KF_NONE, * FDV$K_KF_RFRSH, FDV$K_KF_NONE/ CALL FDV$DFKBD (%DESCR(KEYTABLE),5) RETURN END ******************************************************************************** * This subroutine turns the pointers off on the FMS screen. * ******************************************************************************** SUBROUTINE POINTERS_OFF COMMON /INFO/ TCA,WORK,NDX INTEGER NDX CHARACTER*12 TCA,WORK INCLUDE '($FDVDEF)' CALL VIDEO_OFF ('H1') CALL FDV$PUT (' ','H1',NDX) RETURN END ******************************************************************************** * This subroutine turns the pointers on for the FMS screen. * ******************************************************************************** SUBROUTINE POINTERS_ON COMMON /INFO/ TCA,WORK,NDX INTEGER NDX CHARACTER*12 TCA,WORK INCLUDE '($FDVDEF)' CALL FDV$PUT ('->','H1',NDX) CALL BOLD_REVERSE_ON ('H1') RETURN END ******************************************************************************** * This subroutine turns off all video attributes in the FMS field specified. * ******************************************************************************** SUBROUTINE VIDEO_OFF (FIELD) COMMON /INFO/ TCA,WORK,NDX INTEGER NDX,VIDEO CHARACTER TCA*12,WORK*12,FIELD*(*) INCLUDE '($FDVDEF)' VIDEO = 0 IF (NDX .EQ. 0) THEN CALL FDV$AFVA (VIDEO,FIELD) ELSE CALL FDV$AFVA (VIDEO,FIELD,NDX) ENDIF RETURN END ******************************************************************************** * This subroutine turns on the reverse attribute in the FMS field specified. * ******************************************************************************** SUBROUTINE VIDEO_ON (FIELD) COMMON /INFO/ TCA,WORK,NDX INTEGER NDX,VIDEO CHARACTER TCA*12,WORK*12,FIELD*(*) INCLUDE '($FDVDEF)' VIDEO = 4 IF (NDX .EQ. 0) THEN CALL FDV$AFVA (VIDEO,FIELD) ELSE CALL FDV$AFVA (VIDEO,FIELD,NDX) ENDIF RETURN END ******************************************************************************** * This subroutine turns on the bold and reverse attributes for the FMS field * * specified. * ******************************************************************************** SUBROUTINE BOLD_REVERSE_ON (FIELD) COMMON /INFO/ TCA,WORK,NDX INTEGER NDX,VIDEO CHARACTER TCA*12,WORK*12,FIELD*(*) INCLUDE '($FDVDEF)' VIDEO = 5 IF (NDX .EQ. 0) THEN CALL FDV$AFVA (VIDEO,FIELD) ELSE CALL FDV$AFVA (VIDEO,FIELD,NDX) ENDIF RETURN END ******************************************************************************** * This subroutine gathers current information on all system processes and * * sets up the working data array for the main program. * ******************************************************************************** SUBROUTINE RESAMPLE COMMON /INFO/ TCA,WORK,NDX COMMON /RESAMPLE/ SYSUSER,LINE,MAXPAGE,LASTNDX,NLINES,PAGE INTEGER MAXCNT,STATUS,PIDADR,NFILT,NSYMB,SYS$GETJPIW,SYS$ASCTIM INTEGER MASTERPID,TERM_LEN,PRCNAM_LEN,UNAME_LEN,CPU,STATE,TYPE INTEGER LOGIN(2),MAXPAGE,LASTNDX,NLINES,PAGE,NDX,SKIP,OKSYMB,PID CHARACTER ATIME*23,FILTER(30)*15,PRCNAM*15,TERMINAL*7,UNAME*12 CHARACTER ACPU*16,ALOGIN*23,CTIME*16,TCA*12,WORK*12 LOGICAL SYSUSER INCLUDE '($SSDEF)' INCLUDE '($JPIDEF)' INCLUDE '($STATEDEF)' STRUCTURE /JPI/ UNION MAP INTEGER*2 LEN,COD INTEGER BUF,RET END MAP MAP INTEGER ENDLIST END MAP END UNION END STRUCTURE STRUCTURE /STATE/ INTEGER STAT CHARACTER*5 SYMB END STRUCTURE STRUCTURE /DATA/ UNION MAP CHARACTER*12 UNAME CHARACTER*1 S1 CHARACTER*15 PNAME CHARACTER*1 S2 CHARACTER*5 TERM CHARACTER*2 S3 CHARACTER*1 TYPE CHARACTER*3 S4 CHARACTER*5 STATE CHARACTER*1 S5 CHARACTER*14 CPU CHARACTER*1 S6 CHARACTER*14 CONNECT END MAP MAP CHARACTER*75 WHOLE END MAP END UNION CHARACTER*8 PID END STRUCTURE RECORD /DATA/ LINE(150) RECORD /STATE/ ST(15) RECORD /JPI/ LIST(10) LIST(1).LEN = 4 LIST(1).COD = JPI$_PID LIST(1).BUF = %LOC(PID) LIST(1).RET = 0 LIST(2).LEN = 15 LIST(2).COD = JPI$_PRCNAM LIST(2).BUF = %LOC(PRCNAM) LIST(2).RET = %LOC(PRCNAM_LEN) LIST(3).LEN = 4 LIST(3).COD = JPI$_STATE LIST(3).BUF = %LOC(STATE) LIST(3).RET = 0 LIST(4).LEN = 7 LIST(4).COD = JPI$_TERMINAL LIST(4).BUF = %LOC(TERMINAL) LIST(4).RET = %LOC(TERM_LEN) LIST(5).LEN = 4 LIST(5).COD = JPI$_JOBTYPE LIST(5).BUF = %LOC(TYPE) LIST(5).RET = 0 LIST(6).LEN = 4 LIST(6).COD = JPI$_CPUTIM LIST(6).BUF = %LOC(CPU) LIST(6).RET = 0 LIST(7).LEN = 8 LIST(7).COD = JPI$_LOGINTIM LIST(7).BUF = %LOC(LOGIN) LIST(7).RET = 0 LIST(8).LEN = 12 LIST(8).COD = JPI$_USERNAME LIST(8).BUF = %LOC(UNAME) LIST(8).RET = %LOC(UNAME_LEN) LIST(9).LEN = 4 LIST(9).COD = JPI$_MASTER_PID LIST(9).BUF = %LOC(MASTERPID) LIST(9).RET = 0 LIST(10).ENDLIST = 0 ST(1).STAT = SCH$C_CEF ST(1).SYMB = 'CEF ' ST(2).STAT = SCH$C_COM ST(2).SYMB = 'COM ' ST(3).STAT = SCH$C_COMO ST(3).SYMB = 'COMO ' ST(4).STAT = SCH$C_CUR ST(4).SYMB = 'CUR ' ST(5).STAT = SCH$C_COLPG ST(5).SYMB = 'COLPG' ST(6).STAT = SCH$C_FPG ST(6).SYMB = 'FPG ' ST(7).STAT = SCH$C_HIB ST(7).SYMB = 'HIB ' ST(8).STAT = SCH$C_HIBO ST(8).SYMB = 'HIBO ' ST(9).STAT = SCH$C_LEF ST(9).SYMB = 'LEF ' ST(10).STAT = SCH$C_LEFO ST(10).SYMB = 'LEFO ' ST(11).STAT = SCH$C_MWAIT ST(11).SYMB = 'MWAIT' ST(12).STAT = SCH$C_PFW ST(12).SYMB = 'PFW ' ST(13).STAT = SCH$C_SUSP ST(13).SYMB = 'SUSP ' ST(14).STAT = SCH$C_SUSPO ST(14).SYMB = 'SUSPO' ST(15).STAT = 0 ST(15).SYMB = 'OTHER' ***** Initialize the critical processes to be filtered out. Note that ***** the NULL and SWAPPER processes are filtered out even for those ***** overriding normal filtering procedure. FILTER(1) = 'NULL' ! ALWAYS filter out the NULL process FILTER(2) = 'SWAPPER' ! ALWAYS filter out the SWAPPER FILTER(3) = 'ERRFMT' FILTER(4) = 'CACHE_SERVER' FILTER(5) = 'CLUSTER_SERVER' FILTER(6) = 'OPCOM' FILTER(7) = 'JOB_CONTROL' FILTER(8) = 'CONFIGURE' FILTER(9) = 'VAXsim_Monitor' FILTER(10) = 'NETACP' FILTER(11) = 'REMACP' FILTER(12) = 'DBMS_MONITOR' FILTER(13) = 'ARSAP_Intercept' FILTER(14) = 'ARSAP_Logger' FILTER(15) = 'JMUVAX1_Daemon' FILTER(16) = 'PRT_Daemon' FILTER(17) = 'VTVM2_Daemon' FILTER(18) = 'File_Daemon' FILTER(19) = 'Mail_Daemon' FILTER(20) = 'TIMER' FILTER(21) = 'SYSMONITOR' FILTER(22) = 'ORACLES$BWR' FILTER(23) = 'ORACLES$BIW' FILTER(24) = 'ORACLES$CLN' FILTER(25) = 'ORACLES$ARH' ***** Initialize number of processes to be filtered out (2-30) NFILT = 25 ***** Blank out remaining subscripts of FILTER array DO I = NFILT+1,30 FILTER(I) = ' ' ENDDO NSYMB = 14 ASSIGN 20 TO OKSYMB ASSIGN 30 TO SKIP MAXCNT = 0 STATUS = SS$_NORMAL PIDADR = -1 N = SYS$ASCTIM (,ATIME,,) DO WHILE (STATUS .NE. SS$_NOMOREPROC) ! Loop through all system processes STATUS = SYS$GETJPIW (,PIDADR,,LIST,,,) IF (STATUS .NE. SS$_NOMOREPROC) THEN IF (SYSUSER) THEN IF (PRCNAM(1:PRCNAM_LEN) .EQ. FILTER(1)) GOTO SKIP ! If SYSUSER, filter out only the NULL and IF (PRCNAM(1:PRCNAM_LEN) .EQ. FILTER(2)) GOTO SKIP SWAPPER processes ELSE DO I = 1,NFILT IF (PRCNAM(1:PRCNAM_LEN) .EQ. FILTER(I)) GOTO SKIP ! Filter out critical processes ENDDO ENDIF MAXCNT = MAXCNT + 1 WRITE (LINE(MAXCNT).PID,'(Z8)') PID DO I = 1,NSYMB ! Determine process state IF (STATE .EQ. ST(I).STAT) THEN LINE(MAXCNT).STATE = ST(I).SYMB GOTO OKSYMB ENDIF ENDDO LINE(MAXCNT).STATE = ST(NSYMB+1).SYMB 20 LINE(MAXCNT).TYPE = 'I' ! Determine process type IF (TYPE .EQ. JPI$K_DETACHED) LINE(MAXCNT).TYPE = 'D' IF (TYPE .EQ. JPI$K_NETWORK) LINE(MAXCNT).TYPE = 'N' IF (TYPE .EQ. JPI$K_BATCH) LINE(MAXCNT).TYPE = 'B' IF (TYPE .EQ. JPI$K_REMOTE) LINE(MAXCNT).TYPE = 'R' IF (MASTERPID .NE. 0 .AND. MASTERPID .NE. PID) * LINE(MAXCNT).TYPE = 'S' IF (TERM_LEN .GE. 4) THEN ! Format terminal LINE(MAXCNT).TERM = TERMINAL(1:4)//':' ELSE LINE(MAXCNT).TERM = ' ' ENDIF LINE(MAXCNT).UNAME = UNAME(1:UNAME_LEN) ! Format username IF (UNAME_LEN .LT. 12) * LINE(MAXCNT).UNAME(UNAME_LEN+1:12) = ' ' IF (PRCNAM_LEN .GE. 15) THEN ! Format process name LINE(MAXCNT).PNAME = PRCNAM(1:15) ELSE LINE(MAXCNT).PNAME = PRCNAM(1:PRCNAM_LEN) LINE(MAXCNT).PNAME(PRCNAM_LEN+1:15) = ' ' ENDIF CALL TIMCVT (CPU,ACPU) LINE(MAXCNT).CPU = ACPU(3:16) IF (LOGIN(1) .NE. 0 .OR. LOGIN(2) .NE. 0) THEN ! Determine connect time for process STATUS = SYS$ASCTIM (,ALOGIN,LOGIN,) CALL DELTA_TIME (ATIME,ALOGIN,CTIME,STATUS) ELSE STATUS = 0 ENDIF IF (STATUS .NE. 1) THEN LINE(MAXCNT).CONNECT = ' UNAVAILABLE' ELSE LINE(MAXCNT).CONNECT = CTIME(3:16) ENDIF LINE(MAXCNT).S1 = ' ' ! Initialize blanks in line formatting LINE(MAXCNT).S2 = ' ' LINE(MAXCNT).S3 = ' ' LINE(MAXCNT).S4 = ' ' LINE(MAXCNT).S5 = ' ' LINE(MAXCNT).S6 = ' ' STATUS = SS$_NORMAL 30 CONTINUE ENDIF ENDDO IF (MAXCNT .LE. NLINES) THEN ! Calculate maximum page and maximum index MAXPAGE = 1 number for the last page. LASTNDX = MAXCNT ELSE IF (MOD(MAXCNT,NLINES) .NE. 0) THEN MAXPAGE = MAXCNT/NLINES + 1 ELSE MAXPAGE = MAXCNT/NLINES ENDIF LASTNDX = MAXCNT-((MAXPAGE-1)*NLINES) ENDIF PAGE = 1 NDX = 1 RETURN END ******************************************************************************** * This subroutine handles the FMS activities necessary to display a new page * * of data. * ******************************************************************************** SUBROUTINE NEW_PAGE (FIRST) COMMON /INFO/ TCA,WORK,NDX COMMON /RESAMPLE/ SYSUSER,LINE,MAXPAGE,LASTNDX,NLINES,PAGE INTEGER NDX,MAXPAGE,LASTNDX,NLINES,PAGE,NEXT CHARACTER TCA*12,WORK*12 LOGICAL SYSUSER,FIRST INCLUDE '($FDVDEF)' STRUCTURE /DATA/ UNION MAP CHARACTER*12 UNAME CHARACTER*1 S1 CHARACTER*15 PNAME CHARACTER*1 S2 CHARACTER*5 TERM CHARACTER*2 S3 CHARACTER*1 TYPE CHARACTER*3 S4 CHARACTER*5 STATE CHARACTER*1 S5 CHARACTER*14 CPU CHARACTER*1 S6 CHARACTER*14 CONNECT END MAP MAP CHARACTER*75 WHOLE END MAP END UNION CHARACTER*8 PID END STRUCTURE RECORD /DATA/ LINE(150) IF (PAGE .NE. MAXPAGE) THEN DO I = 1,NLINES NEXT = ((PAGE-1)*NLINES)+I CALL FDV$PUT (LINE(NEXT).WHOLE,'BIG',I) ENDDO ELSE IF (NDX .GT. LASTNDX) NDX = LASTNDX DO I = 1,LASTNDX NEXT = ((PAGE-1)*NLINES)+I CALL FDV$PUT (LINE(NEXT).WHOLE,'BIG',I) ENDDO DO I = LASTNDX+1,NLINES CALL FDV$PUT (' ','BIG',I) ENDDO ENDIF IF (FIRST) THEN CALL FDV$DISPW FIRST = .FALSE. ENDIF RETURN END