	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
