PROGRAM KILL * * Alan L. Zirkle Naval Surface Weapons Center * Code K105 * August 1983 Dahlgren, Virginia 22448 * IMPLICIT INTEGER (A-Z) BYTE QD(0:287), Q(0:83,1) COMMON QD, Q CHARACTER*16 PARAM INTEGER*4 PARAM_CODE LOGICAL*4 BATCH COMMON /PARM/ PARAM, PARAM_CODE, BATCH CHARACTER*16 QNAME INTEGER*4 QNLEN, IQ, QINDEX, POINTER COMMON /QDAT/ QNAME, QNLEN, IQ, QINDEX, POINTER DATA IQ / 0 / INTEGER*4 FLAGS LOGICAL*4 BATCH_Q CALL GET_PARAM CALL GET_USER CALL GET_QUEUES NUMQUE = QD(5) ! SQH$B_NUMQUE 10 IQ = IQ + 1 FLAGS = Q(8,IQ) ! SMQ$B_FLAGS IF (IAND(FLAGS,1) .EQ. 0) GO TO 10 ! SMQ$V_INUSE BATCH_Q = IAND(FLAGS,2) .NE. 0 ! SMQ$V_DETJOB IF (BATCH_Q.NE.BATCH) GO TO 20 QNAME = ' ' QNLEN = Q(16,IQ) ! SMQ$T_NAME DO I=1,QNLEN QNAME(I:I) = CHAR( Q(16+I,IQ) ) ENDDO IF (PARAM_CODE.LT.0.AND.PARAM.NE.QNAME) GO TO 20 CALL PROCESS_QUEUE 20 NUMQUE = NUMQUE - 1 IF (NUMQUE.GT.0) GO TO 10 CALL SELECT END SUBROUTINE GET_PARAM IMPLICIT INTEGER (A-Z) CHARACTER*16 PARAM INTEGER*4 PARAM_CODE / 0 / LOGICAL*4 BATCH COMMON /PARM/ PARAM, PARAM_CODE, BATCH * PARAM_CODE = 0 -- No parameter * > 0 -- Job ordinal * < 0 -- Queue name (in PARAM) CALL CLI$GET_VALUE('$VERB',PARAM) BATCH = PARAM(1:4) .EQ. 'BKIL' IF (.NOT.CLI$PRESENT('P1')) RETURN CALL CLI$GET_VALUE('P1',PARAM) IF (OTS$CVT_TI_L(PARAM,PARAM_CODE,%VAL(4),%VAL(1))) THEN IF (PARAM_CODE.LE.0) CALL EXIT(4) ELSE IF (PARAM(2:).EQ.' ') PARAM = 'LP' // PARAM(1:1) // '0' PARAM_CODE = -1 ENDIF END SUBROUTINE GET_USER IMPLICIT INTEGER (A-Z) CHARACTER*12 USERNAME 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 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 UIC = PROC_UIC END SUBROUTINE GET_QUEUES IMPLICIT INTEGER (A-Z) EXTERNAL SEC$M_SYSGBL, SEC$K_MATALL PARAMETER ( qsize = 252*512 ) PARAMETER ( rsize = qsize - 288 - 84 ) BYTE QD(0:287), Q(0:83,1), REST(rsize) COMMON QD, Q, REST INTEGER MEM(2) MEM(1) = %LOC(QD(0)) MEM(2) = MEM(1) + qsize - 1 STATUS = SYS$MGBLSC(MEM,,,SEC$M_SYSGBL,'JBCSYSQUE',SEC$K_MATALL,) IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS)) END INTEGER*2 FUNCTION I2(I) INTEGER*2 I I2 = I END INTEGER*4 FUNCTION I4(I) INTEGER*4 I I4 = I END SUBROUTINE PROCESS_QUEUE IMPLICIT INTEGER (A-Z) BYTE QD(0:287), Q(0:83,1) COMMON QD, Q CHARACTER*16 PARAM INTEGER*4 PARAM_CODE LOGICAL*4 BATCH COMMON /PARM/ PARAM, PARAM_CODE, BATCH CHARACTER*16 QNAME INTEGER*4 QNLEN, IQ, QINDEX, POINTER COMMON /QDAT/ QNAME, QNLEN, IQ, QINDEX, POINTER QINDEX = 288 + 84 * (IQ-1) POINTER = I4( Q(0,IQ) ) ! SMQ$L_CURRENT 10 IF (POINTER.EQ.0) GO TO 20 CALL PROCESS_JOB( QD(POINTER) , 1 ) GO TO 10 20 IF (PARAM_CODE.LT.0) RETURN POINTER = I4( QD(64) ) ! (pending queue) 30 IF (POINTER.EQ.0) GO TO 40 CALL PROCESS_JOB( QD(POINTER) , 2 ) GO TO 30 40 POINTER = I4( Q(4,IQ) ) ! SMQ$L_HOLDLST 50 IF (POINTER.EQ.0) GO TO 60 CALL PROCESS_JOB( QD(POINTER) , 3 ) GO TO 50 60 POINTER = I4( QD(24) ) ! SQH$L_TIMQUE 70 IF (POINTER.EQ.0) GO TO 80 CALL PROCESS_JOB( QD(POINTER) , 4 ) GO TO 70 80 CONTINUE END SUBROUTINE PROCESS_JOB(JOB,STATE) IMPLICIT INTEGER (A-Z) BYTE JOB(0:119), STATE BYTE QD(0:287), Q(0:83,1) COMMON QD, Q CHARACTER*16 PARAM INTEGER*4 PARAM_CODE LOGICAL*4 BATCH COMMON /PARM/ PARAM, PARAM_CODE, BATCH CHARACTER*16 QNAME INTEGER*4 QNLEN, IQ, QINDEX, POINTER COMMON /QDAT/ QNAME, QNLEN, IQ, QINDEX, POINTER CHARACTER*12 USERNAME INTEGER*4 UIC LOGICAL*1 GROUP, OPER, WORLD COMMON /USER/ USERNAME, UIC, GROUP, OPER, WORLD INTEGER*4 JOBSEQ, JNLEN CHARACTER*12 SUBMITTER CHARACTER*10 JOBNAME BYTE JOBSTATE COMMON /JOB/ SUBMITTER, JOBSEQ, JNLEN, JOBNAME, JOBSTATE INTEGER*4 JOBUIC, GR DATA GR / 'FFFF0000'X / POINTER = I4 ( JOB(8) ) ! SJH$L_NEXTJOB IF ( (STATE.EQ.2 .OR. STATE.EQ.4) .AND. 1 I2(JOB(6)).NE.QINDEX ) RETURN ! SJH$W_QINDEX JOBSEQ = I2 ( JOB(4) ) ! SJH$W_JOBSEQ IF (PARAM_CODE.GT.0.AND.JOBSEQ.NE.PARAM_CODE) RETURN DO I=1,12 SUBMITTER(I:I) = CHAR( JOB(I+23) ) ! SJH$T_USERNAM ENDDO JOBUIC = I4( JOB(20) ) ! SJH$L_UIC IF (SUBMITTER.NE.USERNAME) THEN ! P ! R IF (PARAM_CODE.EQ.0) RETURN ! I ! V IF (.NOT.(OPER.OR.WORLD)) THEN ! I ! C L IF (.NOT.GROUP) RETURN ! H E ! E G IF (IAND(UIC,GR).NE.IAND(JOBUIC,GR)) RETURN ! C E ! K ENDIF ! I ! N ENDIF ! G JOBSTATE = STATE JOBNAME = ' ' JNLEN = JOB(52) ! SJH$T_JOBNAME DO I = 1 , JNLEN JOBNAME(I:I) = CHAR( JOB(52+I) ) ENDDO CALL SAVE_JOB_DATA END SUBROUTINE SAVE_JOB_DATA IMPLICIT INTEGER (A-Z) CHARACTER*16 QNAME INTEGER*4 QNLEN, IQ, QINDEX, POINTER COMMON /QDAT/ QNAME, QNLEN, IQ, QINDEX, POINTER INTEGER*4 JOBSEQ, JNLEN CHARACTER*12 SUBMITTER CHARACTER*10 JOBNAME BYTE JOBSTATE COMMON /JOB/ SUBMITTER, JOBSEQ, JNLEN, JOBNAME, JOBSTATE INTEGER*4 NSTORE / 0 / CHARACTER*45 STORE(32) COMMON /STORAGE/ NSTORE, STORE NSTORE = NSTORE + 1 STATUS=SYS$FAO('!UL',LEN,STORE(NSTORE)(2:7),%VAL(JOBSEQ)) STORE(NSTORE)(1:1) = CHAR( LEN ) STORE(NSTORE)(7:7) = CHAR( QNLEN ) STORE(NSTORE)(8:22) = QNAME STORE(NSTORE)(23:23) = CHAR( JNLEN ) STORE(NSTORE)(24:32) = JOBNAME STORE(NSTORE)(33:44) = SUBMITTER STORE(NSTORE)(45:45) = CHAR( JOBSTATE ) END SUBROUTINE SELECT IMPLICIT INTEGER (A-Z) CHARACTER*16 QNAME INTEGER*4 QNLEN, IQ, QINDEX, POINTER COMMON /QDAT/ QNAME, QNLEN, IQ, QINDEX, POINTER INTEGER*4 JOBSEQ, JNLEN CHARACTER*12 SUBMITTER CHARACTER*10 JOBNAME BYTE JOBSTATE COMMON /JOB/ SUBMITTER, JOBSEQ, JNLEN, JOBNAME, JOBSTATE CHARACTER*12 USERNAME INTEGER*4 UIC LOGICAL*1 GROUP, OPER, WORLD COMMON /USER/ USERNAME, UIC, GROUP, OPER, WORLD INTEGER*4 NSTORE CHARACTER*45 STORE(32) COMMON /STORAGE/ NSTORE, STORE CHARACTER*5 JOBORD CHARACTER*13 WHOSE CHARACTER*7 STATE(4) DATA STATE / 'current','pending','in hold','WAITing' / OPEN (1,FILE='SYS$OUTPUT',STATUS='NEW') IF (NSTORE.LE.0) THEN WRITE (1,1000) CALL EXIT ELSE IF (NSTORE.GT.1) THEN WRITE (1,1001) NSTORE ENDIF DO I=1,NSTORE JOLEN = ICHAR( STORE(I)(1:1) ) JOBORD = STORE(I)(2:6) QNLEN = ICHAR( STORE(I)(7:7) ) QNAME = STORE(I)(8:22) JNLEN = ICHAR( STORE(I)(23:23) ) JOBNAME = STORE(I)(24:32) SUBMITTER = STORE(I)(33:44) JOBSTATE = ICHAR( STORE(I)(45:45) ) IF (SUBMITTER.EQ.USERNAME) THEN WHOSE = 'your' W = 4 ELSE WHOSE = SUBMITTER // ' ' W = INDEX(SUBMITTER,' ') WHOSE(W:W) = 's' ENDIF CALL INQUIRE( WHOSE(1:W),JOBORD(1:JOLEN),JOBNAME(1:JNLEN), 1 STATE(JOBSTATE),QNAME(1:QNLEN) ) ENDDO WRITE (1,1002) 1000 FORMAT ('0No matching jobs found.'/) 1001 FORMAT ('0There are',I3,' matching jobs.') 1002 FORMAT (' ') END SUBROUTINE INQUIRE(WH, JO, JN, ST, QN) IMPLICIT INTEGER (A-Z) CHARACTER*(*) WH, JO, JN, ST, QN CHARACTER*16 PARAM INTEGER*4 PARAM_CODE LOGICAL*4 BATCH COMMON /PARM/ PARAM, PARAM_CODE, BATCH CHARACTER*1 REPLY WRITE (1,1000) WH,JO,JN,ST,QN OPEN (2,FILE='SYS$INPUT',STATUS='OLD') READ (2,1001,END=100,ERR=100) REPLY IF (REPLY.NE.'Y'.AND.REPLY.NE.'y') RETURN WRITE (1,1001) IF (ST(1:1).NE.'c') THEN CALL LIB$DO_COMMAND('DELETE/ENTRY='//JO//' '//QN) ELSE IF (BATCH) THEN CALL LIB$DO_COMMAND('STOP/ENTRY='//JO//' '//QN) ELSE CALL LIB$DO_COMMAND('STOP/ABORT '//QN) ENDIF ENDIF 100 RETURN 1000 FORMAT (/'$Delete ',A,' job ',A,' (',A,'), ',A,' on ',A,' ? ') 1001 FORMAT (A) END