From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CUNYVM.CUNY.EDU::MILILM%VTCC1.BITNET"  7-AUG-1989 21:05
To:	MRGATE::"ARISIA::EVERHART"
Subj:	No Subject

Message-Id:  <8908080102.AA18015@crdgw1.ge.com>
Received: from VTCC1.BITNET by VTVM1.CC.VT.EDU (IBM VM SMTP R1.2.1MX) with BSMTP id 2653; Mon, 07 Aug 89 20:59:48 EDT
Received: by VTCC1 (Jnet BSMTP V0.07) id 1649; Mon,  7 Aug 89 20:48 EDT
Date:     Mon,  7 Aug 89 20:48 EDT
From: Raj Viruru / L.M. Mili <MILILM%VTCC1.BITNET@VTVM1.CC.VT.EDU>
Subject: 
To: EVERHART@ARISIA.decnet
Original_To:   COM%"EVERHART%ARISIA.decnet@CRDGW1.GE.COM"

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X    WRITEV(GROUP_TABLE,'LNM$GROUP_',OCT(UIC.GROUP,6));
X    SET_LOGICAL(
X`009TABLE      := 'LNM$PROCESS_DIRECTORY',
X`009LOG_NAME   := 'LNM$GROUP',
X`009VALUE      := SUBSTR(GROUP_TABLE.BODY,1,GROUP_TABLE.LENGTH),
X`009ACCESS_MODE:= PSL$C_EXEC);
X    END;
X(***************************************************************************
V***)
XPROCEDURE GRANTID;
XBEGIN
X`123
XGet the current UIC
X`125
X    JPI_LIST`0911`093.BUFFER_ADDRESS := IADDRESS(HOLDER.L0);
X    ISTAT := $GETJPI(ITMLST:=JPI_LIST);
X    IF NOT ODD(ISTAT) THEN LIB$STOP(ISTAT);
X
X    HOLDER.L1 := 0;
X    CONTEXT := 0;
X`123
XNow scan the rightslist database and grant all identifiers
Xwhich are to be held by this user
X`125
X    WHILE ODD(ISTAT) DO
X    BEGIN
X`009ISTAT := $FIND_HELD(
X`009    HOLDER`009:= HOLDER,
X`009    ID`009:= IDENTIFIER.L0,
X`009    ATTRIB`009:= IDENTIFIER.L1,
X`009    CONTXT`009:= CONTEXT);
X`009IF ODD(ISTAT) THEN ISTAT := $GRANTID(ID:=IDENTIFIER)
X`009END;
X
X    IF ISTAT <> SS$_NOSUCHID THEN LIB$STOP(ISTAT);
X    END;
X
X(***************************************************************************
V***)
XPROCEDURE REVOKEID;
XBEGIN
X`123
XGet the current UIC
X`125
X    JPI_LIST`0911`093.BUFFER_ADDRESS := IADDRESS(HOLDER.L0);
X    ISTAT := $GETJPI(ITMLST:=JPI_LIST);
X    IF NOT ODD(ISTAT) THEN LIB$STOP(ISTAT);
X
X    HOLDER.L1 := 0;
X    CONTEXT := 0;
X`123
XNow scan the rightslist database and revoke all identifiers held
Xby this user
X`125
X    WHILE ODD(ISTAT) DO
X    BEGIN
X`009ISTAT := $FIND_HELD(
X`009    HOLDER`009:= HOLDER,
X`009    ID`009:= IDENTIFIER.L0,
X`009    ATTRIB`009:= IDENTIFIER.L1,
X`009    CONTXT`009:= CONTEXT);
X`009IF ODD(ISTAT) THEN ISTAT := $REVOKID(ID:=IDENTIFIER)
X`009END;
X
X    IF ISTAT <> SS$_NOSUCHID THEN LIB$STOP(ISTAT);
X    END;
X
X(***************************************************************************
V***)
XPROCEDURE SET_PROCESS_NAME(USERNAME : USERNAME_TYPE);
XVAR
X    TERMINAL_NAME : PACKED ARRAY `0911..30`093 OF CHAR;
X    LNM_ITMLST : ARRAY `0911..2`093 OF ITEM_LIST_TYPE;
X    I : INTEGER;
X
XFUNCTION EOS(VAR STR : `091READONLY`093 PACKED ARRAY`032
X    `091A..B:INTEGER`093 OF CHAR):INTEGER;
XVAR
X    PTR : INTEGER;
X    TMP : INTEGER;
XBEGIN
X    FOR PTR := A TO B DO IF STR`091PTR`093 <> ' ' THEN TMP := PTR;
X    EOS := TMP;
X    END;
X
XBEGIN
X    WITH LNM_ITMLST`0911`093 DO
X    BEGIN
X`009BUFFER_LENGTH`009:= SIZE(TERMINAL_NAME);
X`009ITEM_CODE`009:= LNM$_STRING;
X`009BUFFER_ADDRESS`009:= IADDRESS(TERMINAL_NAME);
X`009RETURN_LEN_ADDR := 0;
X`009END;
X    LNM_ITMLST`0912`093.ITEM_CODE := 0;
X    TERMINAL_NAME := ' ';
X
X    ISTAT := $TRNLNM(TABNAM := 'LNM$PROCESS',
X`009`009     LOGNAM := 'SYS$INPUT',
X`009`009     ITMLST := LNM_ITMLST);
X    IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X    TERMINAL_NAME := SUBSTR(TERMINAL_NAME,5,SIZE(TERMINAL_NAME) - 4);
X    I := INDEX(TERMINAL_NAME,'$');
X    IF I <> 0 THEN
X`009TERMINAL_NAME := SUBSTR(TERMINAL_NAME,I+1,SIZE(TERMINAL_NAME) - I);
X    IF TERMINAL_NAME`0911`093 = '_' THEN
X`009TERMINAL_NAME := SUBSTR(TERMINAL_NAME,2,SIZE(TERMINAL_NAME) - 1);
X    TERMINAL_NAME := '_' + SUBSTR(TERMINAL_NAME,1,SIZE(TERMINAL_NAME) - 1);
X    $SETPRN(SUBSTR(TERMINAL_NAME,1,EOS(TERMINAL_NAME)));
X    $SETPRN(SUBSTR(USERNAME,1,EOS(USERNAME)));
X    END;
X(***************************************************************************
V***)
XPROCEDURE SUB_PROCESS_CHECK;
XVAR
X    ITMLST`009: ARRAY `0911..4`093 OF ITEM_LIST_TYPE;
X    MASTER_PID`009: INTEGER;
X    PID`009`009: INTEGER;
X    PRCCNT`009: INTEGER;
X   `032
XBEGIN
X    ITMLST := ZERO;
X    WITH ITMLST`0911`093 DO
X    BEGIN
X`009BUFFER_LENGTH`009:= 4;
X`009ITEM_CODE`009:= JPI$_MASTER_PID;
X`009BUFFER_ADDRESS`009:= IADDRESS(MASTER_PID);
X`009END;
X    WITH ITMLST`0912`093 DO
X    BEGIN
X`009BUFFER_LENGTH`009:= 4;
X`009ITEM_CODE`009:= JPI$_PID;
X`009BUFFER_ADDRESS`009:= IADDRESS(PID);
X`009END;
X    WITH ITMLST`0913`093 DO
X    BEGIN
X`009BUFFER_LENGTH`009:= 4;
X`009ITEM_CODE`009:= JPI$_PRCCNT;
X`009BUFFER_ADDRESS`009:= IADDRESS(PRCCNT);
X`009END;
X    ISTAT := $GETJPI(ITMLST:=ITMLST);
X    IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X
X    IF PID <> MASTER_PID THEN
X    BEGIN
X`009ISTAT := $GETMSG(BECOME_NOINSUB,ERRMSG.LENGTH,ERRMSG.BODY);
X`009IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X`009WRITELN(ERRMSG);
X`009$EXIT(1);
X`009END;
X
X    IF PRCCNT > 0 THEN
X    BEGIN
X`009ISTAT := $GETMSG(BECOME_NOSUB,ERRMSG.LENGTH,ERRMSG.BODY);
X`009IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X`009WRITELN(ERRMSG);
X`009$EXIT(1);
X`009END;
X    END;
X
X(***************************************************************************
V***)
XPROCEDURE WRITE_ACCOUNTING;
XVAR
X    I,
X    STS`009`009    : INTEGER;
X    PARAMETERS`009    : ARRAY `0910..1`093 OF INTEGER;
X    ITEM_LIST`009    : ARRAY `0910..1`093 OF ITEM_LIST_TYPE;
X    ACCOUNTING_RECORD : PACKED ARRAY `0911..255`093 OF CHAR;
XBEGIN
X`123
XInitialize the item list to zero
X`125
XITEM_LIST := ZERO;
XPARAMETERS := ZERO;
XPARAMETERS`0911`093 := IADDRESS(NEW_USERNAME);
X`123
XGet the format of the accounting message
X`125
XISTAT := $GETMSG(BECOME_BECAME,ERRMSG.LENGTH,ERRMSG.BODY);
XIF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X`123
XDetermine the length of the new username
X`125
XFOR I := 1 TO SIZE(NEW_USERNAME) DO
X    IF NEW_USERNAME`091I`093 <> ' ' THEN PARAMETERS`0910`093 := I;
X`123
XFormat the accounting record
X`125
XSTS := $FAOL(
X`009CTRSTR := SUBSTR( ERRMSG.BODY, 1, ERRMSG.LENGTH ),
X`009OUTLEN := ITEM_LIST`0910`093.BUFFER_LENGTH,
X`009OUTBUF := ACCOUNTING_RECORD,
X`009PRMLST := PARAMETERS);
XIF NOT ODD(STS) THEN $EXIT(STS);
X`123
XInitialize the SNDSBC item list
X`125
XWITH ITEM_LIST`0910`093 DO
X    BEGIN
X    ITEM_CODE`009    := SJC$_ACCOUNTING_MESSAGE;
X    BUFFER_ADDRESS  := IADDRESS(ACCOUNTING_RECORD);
X    END;
X`123
XWrite the accounting record
X`125
XSTS := $SNDJBC(FUNC:=SJC$_WRITE_ACCOUNTING,ITMLST:=ITEM_LIST);
XIF NOT ODD(STS) THEN $EXIT(CODE:=STS);
XEND;
X
X(************   Start of mainline program **************)
XBEGIN
X`123
XFirst try to set this process to have CMKRNL,CMEXEC & SYSPRV - If we can't
Xdo this, the user has no right to run the program
X`125
XSETUP_PRIVS::PRV$TYPE.PRV$V_CMKRNL := TRUE;
XSETUP_PRIVS::PRV$TYPE.PRV$V_CMEXEC := TRUE;
XSETUP_PRIVS::PRV$TYPE.PRV$V_SYSPRV := TRUE;
X
XISTAT := $SETPRV(
X`009ENBFLG`009:= 1,
X`009PRVADR`009:= SETUP_PRIVS);
XIF ISTAT = SS$_NOTALLPRIV THEN $EXIT(SS$_NOPRIV);
XIF NOT ODD (ISTAT) THEN $EXIT(ISTAT);
X`123
XNow get the command from DCL which returns the new username
X`125
XISTAT := LIB$GET_FOREIGN(
X`009    GET_STR`009:= COMMAND_STRING.BODY,
X`009    USER_PROMPT`009:= 'Username: ',
X`009    OUT_LEN     := COMMAND_STRING.LENGTH);
XIF NOT ODD (ISTAT) THEN
X    IF ISTAT = RMS$_EOF THEN
X`009$EXIT(1) ELSE
X`009$EXIT(ISTAT);
X
XISTAT := CLI$DCL_PARSE(
X    'BECOME ' + SUBSTR(COMMAND_STRING.BODY,1,COMMAND_STRING.LENGTH),
X    %IMMED BECOMECLD);
XIF NOT ODD(ISTAT) THEN $EXIT;
X
XIF ODD(CLI$PRESENT('VERSION')) THEN
X    BEGIN
X    ISTAT := $GETMSG(BECOME_VERSION,ERRMSG.LENGTH,ERRMSG.BODY);
X    IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X    ERRMSG := ERRMSG + VER_STRING;
X    WRITELN(ERRMSG);
X    $EXIT;
X    END;
X
XISTAT := CLI$GET_VALUE('P1',NEW_USERNAME);
XIF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X
X`123
XCheck to see if the user is in a subprocess or owns any subprocesses
X`125
XSUB_PROCESS_CHECK;
X`123
XNow set up the item list for the $GETUAI system service
X`125
XWITH GETUAI_LIST`0911`093 DO
XBEGIN
X    BUFFER_LENGTH   := SIZE(DEFDEV);
X    ITEM_CODE`009    := UAI$_DEFDEV;
X    BUFFER_ADDRESS  := IADDRESS(DEFDEV);
X    END;   `032
XWITH GETUAI_LIST`0912`093 DO
XBEGIN
X    BUFFER_LENGTH   := SIZE(DEFDIR);
X    ITEM_CODE`009    := UAI$_DEFDIR;
X    BUFFER_ADDRESS  := IADDRESS(DEFDIR);
X    END;   `032
XWITH GETUAI_LIST`0913`093 DO
XBEGIN
X    BUFFER_LENGTH   := SIZE(UIC);
X    ITEM_CODE`009    := UAI$_UIC;
X    BUFFER_ADDRESS  := IADDRESS(UIC);
X    END;   `032
XWITH GETUAI_LIST`0914`093 DO
XBEGIN
X    BUFFER_LENGTH   := SIZE(ACCOUNT);
X    ITEM_CODE`009    := UAI$_ACCOUNT;
X    BUFFER_ADDRESS  := IADDRESS(ACCOUNT);
X    END;   `032
XWITH GETUAI_LIST`0915`093 DO
XBEGIN
X    BUFFER_LENGTH   := SIZE(PRIV);
X    ITEM_CODE`009    := UAI$_PRIV;
X    BUFFER_ADDRESS  := IADDRESS(PRIV);
X    END;   `032
X`123
XThe the poop on this new username from the UAF file
X`125
XISTAT := $GETUAI(
X    USRNAM  := NEW_USERNAME,
X    ITMLST  := GETUAI_LIST);
X`123
XIf we fould one, do all the heavy work
X`125
XIF ODD(ISTAT) THEN
XBEGIN
X    LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY);`009`123 Disable CTRL/Y while in progr
Vess  `125
X    WRITE_ACCOUNTING;`009`009`009`123 Write an accounting record`009    `125
X    REVOKEID;`009`009`009`009`123 Revoke all the user's rights`009    `125
X    SET_UIC(UIC);`009`009`009`123 Set the new UIC`009`009    `125
X    SET_TABLE_PROT(UIC);`009`009`123 Set the protection on LNM$JOB`009    `1
V25
X    $SETDDIR(SUBSTR(DEFDIR.BODY,1,`009`123 Set the new default directory`009
V    `125
X`009DEFDIR.LENGTH));
X    $CMEXEC(SET_LOGICALS);`009`009`123 Set all of our new logicals`009    `1
V25
X    SET_USERNAME(NEW_USERNAME);`009`009`123 Set the new username fields`009
V    `125
X    SET_PROCESS_NAME(NEW_USERNAME);`009`123 Set our process name via VMS rul
Ves`125
X    SET_ACCOUNT(ACCOUNT);`009`009`123 Set the new account data`009    `125
X    GRANTID;`009`009`009`009`123 Grant all the new identifiers`009    `125
X    SET_PRIVS(PRIV);`009`009`009`123 Set the new user's privs`009    `125
X    LIB$ENABLE_CTRL(LIB$M_CLI_CTRLY);`009`123 Re-enable control/y`009`009
V    `125
X    COMFILES;                           `123 Execute SYLOGIN.COM etc
V           `125
X    END ELSE
X`123
XDidn't find one (or other system service error) print out
Xan error msg
X`125
XBEGIN
X    IF ISTAT = RMS$_RNF THEN
X`009ISTAT := $GETMSG(BECOME_NOUSER,ERRMSG.LENGTH,ERRMSG.BODY) ELSE
X`009ISTAT := $GETMSG(ISTAT,ERRMSG.LENGTH,ERRMSG.BODY);
X    IF NOT ODD(ISTAT) THEN $EXIT(ISTAT);
X    WRITELN(ERRMSG);
X    END;
XEND.
$ CALL UNPACK BECOME.PAS;1 1278081399
$ create/nolog 'f'
X`009MODULE BECOMECLD
X`009IDENT /V1.0/
X!+
X! This module define the syntax for the BECOME foreign command
X!-
X`009DEFINE SYNTAX SHOW_VERSION,NOPARAMETERS
X
X`009DEFINE VERB BECOME
X`009`009PARAMETER P1 VALUE(REQUIRED)
X`009`009QUALIFIER VERSION NONNEGATABLE,SYNTAX=SHOW_VERSION
$ CALL UNPACK BECOMECLD.CLD;1 1216292012
$ create/nolog 'f'
X`009.FACILITY BECOME,1
X
X`009.SEVERITY INFORMATIONAL
X
X`009VERSION <BECOME version >
X
X`009.SEVERITY SUCCESS
X`009BECAME <Became user !AD>/FAO=1
X
X`009.SEVERITY FATAL
X`009NOINSUB`009<You can't BECOME another user while in a subprocess>
X`009NOSUB`009<You can't BECOME another user while you own a subprocess>
X`009UAFNOTFOU <Error opening SYSUAF.DAT>
X`009NOUSER`009<That user does not exist>
X`009.END
$ CALL UNPACK BECOMEMSG.MSG;1 941434870
$ create/nolog 'f'
X`009.TITLE BECOME_SUBROUTINES
X`009.IDENT /01.3/
X;
X; This module has all the macro modules which support the BECOME program
X;
X; Revision history:
X;
X;`009V1.2 1-Oct-1986 WEW
X;`009`009Changed access mode on call to LNM$SEARCHLOG from
X;`009`009KERNEL to EXEC to get rid of the error finding
X;`009`009the logical name
X;
X;`009V1.3 14-Nov-1987 WEW
X;`009`009Made the required changes for VMS V5.x.
X;
X; Include files:
X;
X`009.LIBRARY /SYS$LIBRARY:LIB/`009; Executive macro library
X`009.LINK 'SYS$SYSTEM:SYS.STB'/SELECTIVE_SEARCH
X
X`009$PCBDEF`009`009`009`009; Process Control Block offsets
X`009$JIBDEF`009`009`009`009; Job Information Block offsets
X`009$PHDDEF`009`009`009`009; Process Header Block offsets
X`009$LNMSTRDEF`009`009`009; Logical name definitions
X`009$ORBDEF`009`009`009`009; Object rights block defs
X`009$LNMDEF`009`009`009`009; Logical name
X`009$IPLDEF`009`009`009`009; Processor IPL defs
X`009$PSLDEF`009`009`009`009; PSL bit defs
X;
X; Block to control recursive table name translation
X;
X`009$DEFINI RT
X$DEF`009RT_B_ACMODE,`009.BLKB, 1`009; Access mode
X$DEF`009RT_B_FLAGS,`009.BLKB, 1`009; Flags field
X`009_VIELD RT,0,<-
X`009`009<CASE,,>-`009`009; Caseless flag
X`009`009<TERM,,>>`009`009; Inhibit recursion flag
X$DEF`009RT_B_DEPTH,`009.BLKB, 1`009; Recursion depth
X$DEF`009RT_B_RETRIES,`009.BLKB, 1`009; Recursion tries
X$DEF`009RT_L_CACHEPTR,`009.BLKL, 1`009; Address of cache entry
X$DEF`009RT_A_STACK`009`009`009; Start of recursion stack
X$DEF`009RT_K_BLKLEN`009`009`009; Length of structure
X`009$DEFEND RT
XRT_K_SIZE = RT_K_BLKLEN + LNM$C_MAXDEPTH*4 ; Calculate total block size
X
X
X;---------------------------------------------------------------------------
V----
X`009.PSECT`009DATA,RD,NOWRT,NOEXE,PIC,LONG
XLNM_JOB:.ASCID /LNM$JOB/
X;---------------------------------------------------------------------------
V----
X;
X; Since this is a kernel mode routine R4 already points to the PCB
X; of the current process
X;
X`009.PSECT`009CODE RD,NOWRT,PIC,EXE,LONG
X`009.ENTRY`009SET_UIC `094M<>`009`009; Routine entry point
X`009$CMKRNL_S ROUTIN=10$, -`009`009; Kick into kernel
X`009`009  ARGLST=(AP)`009`009; & pass along the argument list
X`009RET`009`009`009`009; back to the Pascal mainline
X10$:`009.WORD 0`009`009`009`009; Kernel entry point
X`009MOVAL`009HANDLER ,(FP)`009`009; Establish anti-crashing handler
X`009MOVL`009@4(AP),PCB$L_UIC(R4)`009; Stuff the new UIC
X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Set success
X`009RET`009`009`009`009; from kernel
X
X;---------------------------------------------------------------------------
V----
X`009.ENTRY SET_USERNAME `094M<R2,R3,R4,R5,R5> ; Routine entry point
X`009$CMKRNL_S ROUTIN=10$, -`009`009; Kick into kernel
X`009`009  ARGLST=(AP)`009`009; & pass along the argument list
X`009RET`009`009`009`009; back to the Pascal mainline
X10$:`009.WORD`0090`009`009`009; Kernel entry point
X`009MOVAL`009HANDLER, (FP)`009`009; Establish anti-crashing handler
X`009MOVL`009PCB$L_JIB(R4),R0`009; Get JIB address
X`009MOVC3`009#JIB$S_USERNAME,@4(AP),-; Copy the username
X`009`009JIB$T_USERNAME(R0)`009; into the JIB
X`009MOVC3`009#JIB$S_USERNAME,@4(AP),-; Copy the username
X`009`009G`094CTL$T_USERNAME`009; into the CTL region
X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Set success
X`009RET`009`009`009`009; from kernel
X
X;---------------------------------------------------------------------------
V----
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-
