.TITLE BECOME_SUBROUTINES .IDENT /01.3/ ; ; This module has all the macro modules which support the BECOME program ; ; Revision history: ; ; V1.2 1-Oct-1986 WEW ; Changed access mode on call to LNM$SEARCHLOG from ; KERNEL to EXEC to get rid of the error finding ; the logical name ; ; V1.3 14-Nov-1987 WEW ; Made the required changes for VMS V5.x. ; ; Include files: ; .LIBRARY /SYS$LIBRARY:LIB/ ; Executive macro library .LINK 'SYS$SYSTEM:SYS.STB'/SELECTIVE_SEARCH $PCBDEF ; Process Control Block offsets $JIBDEF ; Job Information Block offsets $PHDDEF ; Process Header Block offsets $LNMSTRDEF ; Logical name definitions $ORBDEF ; Object rights block defs $LNMDEF ; Logical name $IPLDEF ; Processor IPL defs $PSLDEF ; PSL bit defs $PRDEF ; ; Block to control recursive table name translation ; $DEFINI RT $DEF RT_L_FLAGS, .BLKL, 1 ; Flags field _VIELD RT,0,<- - ; Caseless flag > ; Inhibit recursion flag $DEF RT_L_ACMODE, .BLKL, 1 ; Access mode $DEF RT_L_DEPTH, .BLKB, 1 ; Recursion depth $DEF RT_L_RETRIES, .BLKB, 1 ; Recursion tries $DEF RT_L_CACHEPTR, .BLKL, 1 ; Address of cache entry $DEF RT_A_STACK, .BLKL, LNM$C_MAXDEPTH ; Start of recursion stack $DEF RT_K_BLKLEN ; Length of structure $DEFEND RT RT_K_SIZE = RT_K_BLKLEN + LNM$C_MAXDEPTH*4 ; Calculate total block size ;------------------------------------------------------------------------------- .PSECT DATA,RD,NOWRT,NOEXE,PIC,LONG LNM_JOB:.ASCID /LNM$JOB/ ;------------------------------------------------------------------------------- ; ; Since this is a kernel mode routine R4 already points to the PCB ; of the current process ; .PSECT CODE RD,NOWRT,PIC,EXE,LONG .ENTRY SET_UIC ^M<> ; Routine entry point movl @4(ap),r1 ; Grab the new UIC so we don't need ; to play arglist games $CMKRNL_S ROUTIN=SETUIC, - ; Kick into kernel ARGLST=0 RET ; back to the Pascal mainline .ENTRY SETUIC,^M<> ; Kernel entry point MOVAL HANDLER ,(FP) ; Establish anti-crashing handler MOVL r1,PCB$L_UIC(R4) ; Stuff the new UIC MOVZBL #SS$_NORMAL, R0 ; Set success RET ; from kernel ;------------------------------------------------------------------------------- .ENTRY SET_USERNAME ^M ; Routine entry point movl 4(ap),setusrname ; copy the arguments somewhere ; that has an address. *** RLI *** $CMKRNL_S ROUTIN=SETUSR, - ; Kick into kernel ARGLST=setusrargs ; & pass along the argument list RET ; back to the Pascal mainline .ENTRY SETUSR, ^M ; Kernel entry point MOVAL HANDLER, (FP) ; Establish anti-crashing handler MOVL PCB$L_JIB(R4),R0 ; Get JIB address MOVC3 #JIB$S_USERNAME,@4(AP),-; Copy the username JIB$T_USERNAME(R0) ; into the JIB MOVC3 #JIB$S_USERNAME,@4(AP),-; Copy the username G^CTL$T_USERNAME ; into the CTL region MOVZBL #SS$_NORMAL, R0 ; Set success RET ; from kernel ;------------------------------------------------------------------------------- .ENTRY SET_ACCOUNT ^M ; Procedure entry point movl 4(ap),setaccname ; copy the argument to ; somewhere with an address *** RLI *** $CMKRNL_S ROUTIN=SETACC, - ; Kick into kernel mode ARGLST=setaccargs ; & pass along the argument list RET ; back to the Pascal mainline .ENTRY SETACC, ^M ; Kernel entry point MOVAL HANDLER, (FP) ; Establish condition handler MOVL PCB$L_JIB(R4), R0 ; Get JIB address MOVC3 #JIB$S_ACCOUNT,@4(AP), -; Copy the account name JIB$T_ACCOUNT(R0) ; into it's JIB location MOVC3 #JIB$S_ACCOUNT,@4(AP),- ; Copy the account name G^CTL$T_ACCOUNT ; into it's P1 location MOVZBL #SS$_NORMAL, R0 ; Set success RET ; from kernel ;------------------------------------------------------------------------------- ;+ ; This routine is used to set the current process privs. Note that ; it doesn't touch the authorized priv mask in the PHD. This allows ; us to "become" ourselves again. ;- .ENTRY SET_PRIVS ^M<> ; Routine entry point movL 4(ap),setprivvalue ; copy the argument to a place ; with an address. *** RLI *** $CMKRNL_S ROUTIN=SETPRIV,- ; Kick into kernel ARGLST=setprivargs ; & pass the argument pointer RET ; back to the Pascal mainline .ENTRY SETPRIV, ^M<> ; Kernel entry point MOVAL HANDLER, (FP) ; Establish condition handler MOVQ @4(AP), G^CTL$GQ_PROCPRIV ; Set permanent process privs MOVQ @4(AP), PCB$Q_PRIV(R4) ; Set current privs MOVL PCB$L_PHD(R4), R0 ; Get pointer to process header MOVQ @4(AP), PHD$Q_PRIVMSK(R0); Set the other copy of current privs MOVZBL #SS$_NORMAL, R0 ; Return success RET ; from kernel ;------------------------------------------------------------------------------- ;+ ; This routine sets the owner of job logical name table to the ; new uic of the user. The owner is in the objects rights block ; which is pointed to from the logical name table structure. ;- .ENTRY SET_TABLE_PROT ^M ; Routine entry point movl @4(ap),setblowner ; copy the argument somewhere with ; an address. *** RLI *** $CMKRNL_S ROUTIN = SETBL, - ; Kick intor kernel ARGLST=setblargs ; & pass the argument list BLBS R0, 5$ ; Branch if success PUSHL R1 CALLS #1, G^LIB$SIGNAL PUSHL R0 ; Push the bad status CALLS #1, G^LIB$STOP ; Crash on errors 5$: RET ; back to the Pascal mainline .ENTRY SETBL,^M ; Kernel entry point MOVAB HANDLER, (FP) ; Establish condition handler ;+ ; Raise IPL to AST delivery level so that there are no interruptions while the ; translation of the logical name is being carried out, lock the logical name ; mutex for reading, and then search for the specified logical name. ;- SETIPL S^#IPL$_ASTDEL ; Raise IPL to AST delivery level JSB G^LNM$LOCKR ; Lock tables for reading SUBL #RT_K_SIZE, SP ; Allocate a recursion control block MOVL SP, R5 ; Set the address in the proper reg MOVL #PR$C_PS_EXEC, RT_L_ACMODE(R5) ; Set the proper access mode CLRL RT_L_FLAGS(R5) ; Initialize the flags field BBSS #RT_V_CASE,RT_L_FLAGS(R5),11$ ; Set the proper flag bit 11$: MOVQ LNM_JOB, R2 ; Get table name descriptor MOVZWL R2, R2 ; Clear the high order word ;+ ; Call to LNM$SETUP expects the following registers to be set up: ; ; R2 - Length of table name string ; R3 - Address of logical name string ; R5 - Address of recursion table search control block ; Returns: ; ; R0 low bit clear indicates search failure. ; R0 - SS$_NOLOGNAM -No logical name match found. ; R1 - Address of logical name block on which search failed ; ; R0 low bit set indictes success with: ; R1 - Address of logical name table block that contains match ; ; All other registers are preserved ;- JSB G^LNM$SETUP ; Search for the logical name block PUSHL R0 ; Save the search status BLBC R0, 20$ ; Branch if no name found MOVL LNMTH$L_ORB(R1), R1 ; Get address of object rights block MOVL 4(AP), ORB$L_OWNER(R1) ; Set the new owner of the table 20$: JSB G^LNM$UNLOCK ; Release lock on logical name mutex SETIPL #0 ; Drop our IPL to zero POPL R0 ; Get status RET ; Return from kernel mode ;------------------------------------------------------------------------------- .PSECT COND_HANDLER RD,NOWRT,PIC,EXE,LONG .ENTRY HANDLER ^M<> ; ; First get the mutex count out of our PCB to see if we should ; release the I/O sub-system before exiting ; MOVL G^CTL$GL_PCB, R4 ; Get our current PCB TSTL PCB$L_MTXCNT(R4) ; Any mutex's held ? BEQL 10$ ; Branch if nope... JSB G^LNM$UNLOCK ; Release our mutex SETIPL #0 ; Drop our IPL to zero 10$: $EXIT_S ; Cause process to exit .psect rlikludge,wrt ;-- argument list for cmkrnl to setusr *** RLI *** setusrargs: .long 1 setusrname: .long 0 ;-- argument list for cmkrnl call to setacc *** RLI *** setaccargs: .long 1 setaccname: .long 0 ;-- argument list for cmkrnl call to setpriv *** RLI *** setprivargs: .long 1 setprivvalue: .long 0 ;-- argument for cmkrnl to setbl *** RLI *** setblargs: .long 1 setblowner: .long 0 .END