PROGRAM KILL ** * PROGRAMS KILL AND BKILL * * * 16 May 85 Rewrite for VMS Version 4. * * * Alan L. Zirkle Naval Surface Weapons Center * Code K105 * August 1983 Dahlgren, Virginia 22448 * * * Based on the 'QDISPLAY' program by: * * John Chong * Harris Corporation / Farinon Division * 1691 Bayport Avenue * San Carlos, CA 94070 * (415) 594-3582 * IMPLICIT INTEGER (A-Z) INCLUDE '($QUIDEF)/NOLIST' CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN INTEGER*2 IOSB(4) DATA STAT / 1 / CALL INITIALIZE DO WHILE (STAT) STAT = SYS$GETQUIW(,%VAL(DQ),,QUEUE_ITEM_LIST,IOSB,,) IF (.NOT.STAT) CALL LIB$STOP(%VAL(STAT)) STAT = IOSB(1) IF (STAT) THEN STAT2 = 1 DO WHILE (STAT2) STAT2 = SYS$GETQUIW(,%VAL(DJ),,JOB_ITEM_LIST,IOSB,,) IF (.NOT.STAT2) CALL LIB$STOP(%VAL(STAT2)) STAT2 = IOSB(1) IF (STAT2 .AND. .NOT. BTEST(JOB_STATUS,IN)) THEN CALL CHECK_JOB ENDIF ENDDO ENDIF ENDDO STATUS = SYS$GETQUIW(,%VAL(QUI$_CANCEL_OPERATION),,,IOSB,,) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) IF (.NOT.IOSB(1)) CALL LIB$STOP(%VAL(IOSB(1))) CALL SELECT_JOB END SUBROUTINE CHECK_JOB IMPLICIT INTEGER (A-Z) CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN CHARACTER PARAM*32 LOGICAL*1 BATCH COMMON /PARAM_/ PARAM,PA_LEN,PARAM_CODE,BATCH CHARACTER USERNAME*12 INTEGER*4 UIC LOGICAL*1 GROUP,OPER,WORLD COMMON /USER_/ USERNAME,UIC,GROUP,OPER,WORLD IF (PARAM_CODE.LT.0) THEN IF (PARAM(1:PA_LEN).NE.QUEUE_NAME(1:QN_LEN)) RETURN ELSE IF (PARAM_CODE.GT.0) THEN IF (PARAM_CODE.NE.ENTRY_NUMBER) RETURN ENDIF * Check privileges. IF (SUBMITTER(1:SU_LEN).NE.USERNAME) THEN IF (PARAM_CODE.EQ.0) RETURN IF (.NOT. (OPER .OR. WORLD)) THEN IF (.NOT.GROUP) RETURN IF (IAND(UIC,'FFFF0000'X).NE. 1 IAND(JOB_UIC,'FFFF0000'X)) RETURN ENDIF ENDIF CALL SAVE_JOB_DATA END SUBROUTINE SAVE_JOB_DATA IMPLICIT INTEGER (A-Z) CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN PARAMETER ( storage_size = 64 ) CHARACTER*87 STORAGE(storage_size) COMMON /STORAGE_/ NST,STORAGE CHARACTER JST*2 EQUIVALENCE (JST,JOB_STATUS) DATA NST / 0 / NST = MIN(NST+1,storage_size) CALL SYS$FAO('!UL',LEN,STORAGE(NST)(2:7),%VAL(ENTRY_NUMBER)) STORAGE(NST)(1:1) = CHAR(LEN) STORAGE(NST)(8:8) = CHAR(QN_LEN) STORAGE(NST)(9:40) = QUEUE_NAME STORAGE(NST)(41:41) = CHAR(JN_LEN) STORAGE(NST)(42:73) = JOB_NAME STORAGE(NST)(74:85) = SUBMITTER(1:SU_LEN) STORAGE(NST)(86:87) = JST END SUBROUTINE SELECT_JOB IMPLICIT INTEGER (A-Z) CHARACTER PARAM*32 LOGICAL*1 BATCH COMMON /PARAM_/ PARAM,PA_LEN,PARAM_CODE,BATCH CHARACTER USERNAME*12 INTEGER*4 UIC LOGICAL*1 GROUP,OPER,WORLD COMMON /USER_/ USERNAME,UIC,GROUP,OPER,WORLD CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN PARAMETER ( storage_size = 64 ) CHARACTER*87 STORAGE(storage_size) COMMON /STORAGE_/ NST,STORAGE CHARACTER ENTRY*6,WHOSE*13,LABEL*10,LABELS(0:11)*10,JST*2 EQUIVALENCE (JST,JOB_STATUS) DATA LABELS / 'pending','aborting','executing','in hold', 1 '--','refused','requeue?','restarting','retained', 2 'starting','WAITing','printing' / IF (NST.EQ.0) THEN PRINT 1000 CALL EXIT ELSE IF (NST.GT.1) THEN PRINT 1001,NST ENDIF DO I=1,NST EN_LEN = ICHAR( STORAGE(I)(1:1) ) ENTRY = STORAGE(I)(2:7) QN_LEN = ICHAR( STORAGE(I)(8:8) ) QUEUE_NAME = STORAGE(I)(9:40) JN_LEN = ICHAR( STORAGE(I)(41:41) ) JOB_NAME = STORAGE(I)(42:73) SUBMITTER = STORAGE(I)(74:85) JST = STORAGE(I)(86:87) IF (SUBMITTER.EQ.USERNAME) THEN WHOSE = 'your' WH_LEN = 4 ELSE WHOSE = SUBMITTER WH_LEN = STR_LEN(WHOSE) + 1 WHOSE(WH_LEN:WH_LEN) = 's' ENDIF ISTAT = 0 DO J=0,9 IF (BTEST(JOB_STATUS,J)) ISTAT = J + 1 ENDDO IF (ISTAT.EQ.2 .AND. .NOT.BATCH) ISTAT = 11 LABEL = LABELS(ISTAT) LA_LEN = STR_LEN(LABEL) CALL INQUIRE(ENTRY(1:EN_LEN),WHOSE(1:WH_LEN), 1 LABEL(1:LA_LEN)) ENDDO PRINT 1002 1000 FORMAT ('0No matching jobs found.'/) 1001 FORMAT ('0There are',I3,' matching jobs.') 1002 FORMAT (' ') END SUBROUTINE INQUIRE(ENTRY,WHOSE,LABEL) IMPLICIT INTEGER (A-Z) CHARACTER*(*) ENTRY,WHOSE,LABEL CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN CHARACTER REPLY*1,COMMAND*80 PRINT 1000,WHOSE,JOB_NAME(1:JN_LEN),ENTRY,LABEL, 1 QUEUE_NAME(1:QN_LEN) READ (*,1001,END=100,ERR=100) REPLY IF (REPLY.NE.'Y' .AND. REPLY.NE.'y') RETURN PRINT 1001 IF (LABEL.EQ.'printing') THEN COMMAND = 'STOP/ABORT ' // QUEUE_NAME(1:QN_LEN) ELSE IF (LABEL.EQ.'executing') THEN COMMAND = 'STOP/ENTRY=' // ENTRY // ' ' // 1 QUEUE_NAME(1:QN_LEN) ELSE COMMAND = 'DELETE/ENTRY=' // ENTRY // ' ' // 1 QUEUE_NAME(1:QN_LEN) ENDIF C_LEN = STR_LEN(COMMAND) STATUS = LIB$SPAWN(COMMAND(1:C_LEN),,,2) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) 100 RETURN 1000 FORMAT (/'$Delete ',A,' job ',A,' (',A,') ',A,' on ',A,' ? ') 1001 FORMAT (A) END SUBROUTINE INITIALIZE IMPLICIT INTEGER (A-Z) CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32 INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19) COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN, 1 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER, 2 JOB_STATUS,JOB_UIC,DQ,DJ,IN CHARACTER PARAM*32 LOGICAL*1 BATCH COMMON /PARAM_/ PARAM,PA_LEN,PARAM_CODE,BATCH INTEGER*2 IOSB(4) CHARACTER SEARCH_NAME*1 DATA SEARCH_NAME,SN_LEN / '*' , 1 / INCLUDE '($QUIDEF)/NOLIST' CALL GET_PARAMETER CALL GET_USER_INFO IF (BATCH) THEN SEARCH_FLAGS = QUI$M_SEARCH_WILDCARD + 1 QUI$M_SEARCH_ALL_JOBS + QUI$M_SEARCH_BATCH ELSE SEARCH_FLAGS = QUI$M_SEARCH_WILDCARD + 1 QUI$M_SEARCH_ALL_JOBS + QUI$M_SEARCH_SYMBIONT ENDIF CALL ITEM_LIST(QUEUE_ITEM_LIST,QUI$_SEARCH_FLAGS,SEARCH_FLAGS, 1 QUI$_SEARCH_NAME,SEARCH_NAME,SN_LEN, 2 QUI$_QUEUE_NAME,QUEUE_NAME,QN_LEN) CALL ITEM_LIST(JOB_ITEM_LIST,QUI$_SEARCH_FLAGS,SEARCH_FLAGS, 1 QUI$_ENTRY_NUMBER,ENTRY_NUMBER, 2 QUI$_USERNAME,SUBMITTER,SU_LEN, 3 QUI$_JOB_NAME,JOB_NAME,JN_LEN, 4 QUI$_JOB_STATUS,JOB_STATUS, 5 QUI$_UIC,JOB_UIC) STATUS = SYS$GETQUIW(,%VAL(QUI$_CANCEL_OPERATION),,,IOSB,,) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) IF (.NOT.IOSB(1)) CALL LIB$STOP(%VAL(IOSB(1))) DQ = QUI$_DISPLAY_QUEUE ! We do these so we DJ = QUI$_DISPLAY_JOB ! don't have to call IN = QUI$M_JOB_INACCESSIBLE ! $QUIDEF elsewhere END SUBROUTINE GET_PARAMETER IMPLICIT INTEGER (A-Z) CHARACTER PARAM*32 LOGICAL*1 BATCH COMMON /PARAM_/ PARAM,PA_LEN,PARAM_CODE,BATCH * PARAM_CODE = 0 -- No parameter on command * > 0 -- Parameter is job ordinal (value in PARAM_CODE) * < 0 -- Parameter is queue name (value in PARAM) DATA PARAM_CODE / 0 / CALL CLI$GET_VALUE('$VERB',PARAM) BATCH = PARAM(1:4) .EQ. 'BKIL' IF (CLI$PRESENT('P1')) THEN CALL CLI$GET_VALUE('P1',PARAM,PA_LEN) IF (OTS$CVT_TI_L(PARAM(1:PA_LEN),PARAM_CODE, 1 %VAL(4),%VAL(1))) THEN IF (PARAM_CODE.LE.0) CALL EXIT('10000004'X) ELSE PARAM_CODE = -1 IF (BATCH) CALL EXIT('10000004'X) IF (PA_LEN.EQ.1) THEN PARAM(1:4) = 'LP' // PARAM(1:1) // '0' PA_LEN = 4 ENDIF ENDIF ENDIF END SUBROUTINE GET_USER_INFO IMPLICIT INTEGER (A-Z) CHARACTER USERNAME*12 INTEGER*4 UIC LOGICAL*1 GROUP,OPER,WORLD COMMON /USER_/ USERNAME,UIC,GROUP,OPER,WORLD INTEGER*4 PROC_PID,PROC_STAT,PROC_UIC CHARACTER*16 PROC_NAME CHARACTER*8 TERM_NAME CHARACTER*12 USER_NAME INTEGER*2 PNLEN,TNLEN,UNLEN COMMON /USER_DATA_/ PROC_PID, PROC_STAT,PROC_UIC, 1 PROC_NAME,TERM_NAME,USER_NAME, 2 PNLEN, TNLEN, UNLEN OPER = USER_HAS_PRIV('OPER') WORLD = USER_HAS_PRIV('WORLD') GROUP = USER_HAS_PRIV('GROUP') USERNAME = USER_NAME(1:UNLEN) UIC = PROC_UIC END