PROGRAM force_exit
C
C Program to implement the FORCEXIT foreign command to force a process to
C terminate:
C
C+ FORCEXIT
C
C The FORCEXIT (foreign) command is used to force a process to terminate.
C 
C		FORCEXIT{/IDENTIFICATION=pid} {process-name}
C
C Define via:
C		FORCEX*IT :== $FORCEXIT
C
C Using FORCEXIT rather than the STOP command causes the exit handlers of
C the process being terminated to be activated (it is a "softer" terminate).
C
C Any user can use FORCEXIT on one of his/her subprocesses.  GROUP 
C privilege is needed to use FORCEXIT on detached processes of users
C with the same group number while WORLD privilege allows any process to
C be forced to exit.  Note that the process name can only be used
C when dealing with subprocesses or processes owned by users in the same
C group.
C
C-
C
	IMPLICIT INTEGER*4 (A - Z)
C
	INCLUDE 'SYS$LIBRARY:SSDEF.FOR/NOLIST'	!System completion codes
	PARAMETER DCL$_IVKEYW = '00038060'X	!Invalid keyword
C
	CHARACTER*80 command
	CHARACTER*16 qualifier
	INTEGER*4 pid,sys$forcex
C
	DATA qualifier/'/IDENTIFICATION'/
C
C Get the command line after the verb (FORCEXIT)
C
	status = LIB$GET_FOREIGN(command,'Process? ',length)
	IF (.NOT.status) CALL LIB$STOP(%VAL(status))
C
C Convert the command line to all uppercase.
C
	status = STR$UPCASE(command,command(1:length))
	IF (.NOT.status) CALL LIB$STOP(%VAL(status))
C
C Find out if the /IDENT... qualifier was used
C
	start = LIB$LOCC('/',command(1:length))
	IF (start.NE.0) THEN
	    endstr = LIB$LOCC('=',command(start:length))
	    IF (endstr.EQ.0) CALL LIB$STOP(%VAL(DCL$_IVKEYW))
C
C Check size and content of string for proper keyword
C
	    size = endstr-start
	    IF (size.LT.3) CALL LIB$STOP(%VAL(DCL$_IVKEYW))
	    IF (command(start:endstr-1).NE.qualifier(1:size))
	1	CALL LIB$STOP(%VAL(DCL$_IVKEYW))
C
C Get process id in hexadecimal
C
	    status = ots$cvt_tz_l(command(endstr+1:length),pid)
	    IF (.NOT.status) CALL LIB$STOP(%VAL(status))
C
C now force the requested process with the process id to exit
C with completion code SS$_OPRABORT
C
	    status = sys$forcex(pid,,%VAL(SS$_OPRABORT))
	    IF (.NOT.status) CALL LIB$STOP(%VAL(status))
C
	    ELSE
C
C No qualifier, try to get process name from command line
C
	    IF (length.NE.0) THEN
C
C now force the requested process using the process name to exit
C with completion code SS$_OPRABORT
C
		pid = 0
		status = sys$forcex(pid,command(1:length),
	1			%VAL(SS$_OPRABORT))
		IF (.NOT.status) CALL LIB$STOP(%VAL(status))
C
		ENDIF
C
	    ENDIF
C
	END