From:	CSBVAX::MRGATE!FOP%SECTHF51.BITNET@CUNYVM.CUNY.EDU@SMTP 22-MAR-1988 15:29
To:	ARISIA::EVERHART
Subj:	Forced exit


Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Sat 19 Mar 88 07:26:07-PST
Received: from SECTHF51.BITNET by CUNYVM.CUNY.EDU ; Sat, 19 Mar 88 10:23:32 EST
Date:     Sat, 19 Mar 88 16:22 EDT
From:     <FOP%SECTHF51.BITNET@CUNYVM.CUNY.EDU>
Subject:  Forced exit
To:       info-vax@kl.sri.com
X-Original-To:  info-vax@kl.sri.com

There has recently been some intrerest in forced exit and related subjects...
Since nobody has asked for this little program, I've decided to post it.

---
Daniel Berglund
Chalmers University of Technology
G|teborg, Sweden

fop@secthf51
foperator@tekn01.chalmers.se
-------------------------------------------------------------------------------
"THIS IS VERY USEFULL FOR ME I SUDDENLY BECOMES A MANAGER OR SYSTEM OR MYSELF
OR OTHERS"

$!..................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by FOPERATOR
$! on Saturday 19-MAR-1988 15:42:15.15
$!
$! It contains the following 6 files:
$! BUILD.COM DESCRIP.MMS FEXIT.HLP FORCE.CLD FORCE.PAS FORCEMSG.MSG
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="BUILD.COM"
$ Check_Sum_is=1562390223
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ PASCAL FORCE
X$ MESS FORCEMSG
X$ LINK/NOTRACE FORCE,FORCEMSG
$ GoSub Convert_File
$ File_is="DESCRIP.MMS"
$ Check_Sum_is=1214469189
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xforce.exe : `009force.obj,forcemsg.obj
X`009`009link/notrace force+forcemsg
X
Xforcemsg.obj : `009forcemsg.msg
X
Xforce.obj : `009force.pas
$ GoSub Convert_File
$ File_is="FEXIT.HLP"
$ Check_Sum_is=1483702253
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X1 FEXIT
X
X Forces image exit on behalf of another process.
X
XFormat:
X
X        FEXIT [/Qualifiers]
X2 Qualifiers
X/CONFIRM
X
X Controls whether a request is issued  before  each  individual FEXIT
X operation  to confirm that the operation should be performed on that
X process.
X/EXIT_CODE
X
X /EXIT_CODE[=number]
X
X  The final exit code of the target process. Defaults to
X  FORCEDEXIT.
X/ID
X
X Hexadecimal identification code of the target process.
X/LOG
X
X Controls whether the FEXIT command displays a log message after the
X operation has been applied to the target process.
$ GoSub Convert_File
$ File_is="FORCE.CLD"
$ Check_Sum_is=574252164
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xdefine verb FEXIT
X     image U:[FOPERATOR.SOFT.FORCE]FORCE
X     qualifier LOG
X     qualifier CONFIRM
X     qualifier IDENTIFICATION, value(required)
X     qualifier EXIT_CODE, value (required,type=$number)
$ GoSub Convert_File
$ File_is="FORCE.PAS"
$ Check_Sum_is=209610959
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X[INHERIT('SYS$LIBRARY:STARLET')]
XPROGRAM force (INPUT,OUTPUT);
X
X(*+++                                                                *)
X(* Version 4-001      1987-03-16       Daniel Berglund     Created.  *)
X(*         4-002      1987-07-22       dB                            *)
X(*`009   4-003      1987-08-06       --JN                          *)
X(*         4-004      1988-03-17       dB                  Bugfix.   *)
X(*                                                                   *)
X(* Copyrigth 1988 by FOPERATOR Software Inc.                         *)
X(*                                                                   *)
X(*---                                                                *)
XCONST
X   CLI$_PRESENT   = 261401;
X   CLI$_DEFAULTED = 261409;
X   CLI$_ABSENT    = 229872;
X   CLI$_NEGATED   = 229880;
X
XTYPE
X   $UWORD = [WORD] 0..65535;
X   item = PACKED RECORD
X                    len : $UWORD;
X                    code : $UWORD;
X                    bufadr : [UNSAFE] integer;
X                    retlen : [UNSAFE] integer;
X          END;
X
XVAR
X   itmlst   : PACKED ARRAY[1..4] OF item;
X   priv     : PRV$TYPE;
X   con      : char := 'Y';
X   pid      : UNSIGNED;
X   exit_code: UNSIGNED;
X   pid_txt  : PACKED ARRAY[1..10] OF char := '          ';
X   exit_code_txt : PACKED ARRAY[1..20] OF char;
X   status   : integer;
X   msglen   : $UWORD;
X   msg_id   : PACKED ARRAY [1..200] OF char;
X   prcnam   : PACKED ARRAY [1..16] OF char;
X   username : PACKED ARRAY [1..12] OF char;
X   retlen   : $UWORD;
X
X   FORCE_FORCED, FORCE_NOFORCE, FORCE_INVNUM : [EXTERNAL,VALUE] integer;
X
X[ASYNCHRONOUS,EXTERNAL(LIB$SIGNAL)] FUNCTION $SIGNAL (
X`009`009`009`009apa : [UNSAFE,LIST,IMMEDIATE] integer
X`009): integer ;EXTERNAL;
X
X[EXTERNAL] FUNCTION CLI$GET_VALUE(
X                    %STDESCR name : PACKED ARRAY [$l1..$u1:integer] OF char;
X                    %STDESCR retbuf : PACKED ARRAY [$l2..$u2:integer] OF char;
X`009`009    %REF retlen : $UWORD := 0
X                    ) : integer; EXTERNAL;
X
X[EXTERNAL] FUNCTION CLI$PRESENT(
X                    %STDESCR name : PACKED ARRAY [$l..$u : integer] OF char
X                    ) : integer; EXTERNAL;
X
X[EXTERNAL] FUNCTION OTS$CVT_TZ_L(
X                    %STDESCR inp_str : PACKED ARRAY[$l..$u:integer] OF char;
X                    VAR value : UNSIGNED;
X                    value_size : UNSIGNED := %IMMED 4;
X                    flags : UNSIGNED := %IMMED 1):integer; EXTERNAL;
X
X
XBEGIN
X   priv.PRV$V_WORLD := TRUE;
X   priv.PRV$V_GROUP := TRUE;
X   $SETPRV(ENBFLG:=1,PRVADR:=priv,PRMFLG:=0);
X
X   IF CLI$PRESENT('IDENTIFICATION') = CLI$_ABSENT
X   THEN
X      pid := 0
X   ELSE
X   BEGIN
X      status := CLI$GET_VALUE('IDENTIFICATION',pid_txt);
X      IF NOT ODD(status) THEN $EXIT(status);
X      status := OTS$CVT_TZ_L(pid_txt,pid);
X      IF NOT ODD(status) THEN $EXIT(status);
X   END;
X
X   itmlst[1].code`009:= JPI$_PRCNAM;
X   itmlst[1].len`009:= 16;
X   itmlst[1].bufadr`009:= IADDRESS(prcnam);
X   itmlst[1].retlen`009:= 0;
X   itmlst[2].code`009:= JPI$_USERNAME;
X   itmlst[2].len`009:= 12;
X   itmlst[2].bufadr`009:= IADDRESS(username);
X   itmlst[2].retlen`009:= 0;
X   itmlst[3].code`009:= 0;
X   itmlst[3].len`009:= 0;
X   itmlst[3].bufadr`009:= 0;
X   status := $GETJPI(ITMLST:=itmlst,PIDADR:=pid);
X   IF NOT ODD(status) THEN $EXIT(status);
X
X   IF CLI$PRESENT('EXIT_CODE') = CLI$_ABSENT
X   THEN
X      exit_code := SS$_FORCEDEXIT
X   ELSE
X   BEGIN
X      status := CLI$GET_VALUE('EXIT_CODE',exit_code_txt,retlen);
X      readv(exit_code_txt,exit_code,ERROR:=CONTINUE);
X      IF statusv <> 0 THEN
X         $SIGNAL(FORCE_INVNUM,1,%STDESCR(SUBSTR(exit_code_txt,1,retlen)));
X   END;
X
X   IF CLI$PRESENT('CONFIRM') = CLI$_PRESENT THEN BEGIN
X      WRITE('Force process ',prcnam,' (user ',username,')? [N] ');
X      READ(con);
X   END;
X
X   IF (con IN ['Y','y','T','t','1']) THEN BEGIN
X      status := $FORCEX(PIDADR:=pid, CODE:=exit_code);
X      IF CLI$PRESENT('LOG') = CLI$_ABSENT THEN $EXIT(status);
X      IF NOT ODD(status) THEN BEGIN
X         $SIGNAL(FORCE_NOFORCE,%IMMED(1),%IMMED(pid));
X         $EXIT(status)
X      END
X      ELSE BEGIN
X         status:=$GETMSG(exit_code,msglen,msg_id,15);
X         IF NOT ODD(status) THEN $EXIT(status);
X         $SIGNAL(FORCE_FORCED,2,pid,%STDESCR SUBSTR(msg_id,1,msglen));
X         $EXIT(status);
X      END
X   END;
XEND.
$ GoSub Convert_File
$ File_is="FORCEMSG.MSG"
$ Check_Sum_is=70519784
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X.TITLE FORCE_MESSAGES
X
X.FACILITY FORCE,1/PREFIX=FORCE_
X.SEVERITY FATAL
X
X`009INVNUM`009`009<"!AS" is an invalid value for an exit code>/FAO=1
X
X.SEVERITY ERROR
X
X`009NOFORCE`009`009<process !XL not forced to exit>/FAO=1
X
X.SEVERITY SUCCESS
X
X`009FORCED`009`009<process !XL forced to exit with status !/ "!AS">/FAO=2
X
X.END
$ GoSub Convert_File
$ Exit
