.TITLE SYMDELSETB ; set a symbol in another process .IDENT "SYMBOL v3%4.091" ; internals demo program... ;++ ; This program demonstrates the use of a piggyback special kernel AST and ; provides a mechanism to set or delete DCL symbols in another process. ; ; This program uses the CLI$func interface RTLs to obtain the pertainent ; information from the command line. A command definition file provides ; a DCL like command interface and syntax. When the command information ; has been obtained, a kernel mode routine is executed which will alloc- ; ate non-paged pool for an ACB and an extension which contains pertain- ; ent information from the command line. This ACB is then queued to the ; target process. The AST routines are located in a Loadable Executive ; Image (LEI). ;-- ; USES: A great utility for teaching a lesson to un*x types on OpenVMS ; systems that insist on creating throngs of symbols to emulate their ; beloved cryptic un*x command interfaces. For example: ; ; SYMBOL/SET/ID=# GREP WRITE SYS$OUTPUT "Grep, schmep! Go YACC yourself off!" ;-- ; Copyright © 1993, 1994 by Brian Schenkenberger and TMESIS Consulting ; All rights reserved. ; ------------------------- ; This software is provided "as is" and is supplied for informational purpose ; only. No warranty is expressed or implied and no liability can be accepted ; for any actions or circumstances incurred from the use of this software or ; from the information contained herein. The author makes no claim as to the ; suitablility or fitness of this software or information contain herein for ; a particular purpose. ; ------------------------- ; This software may be copied and distributed only with the inclusion of this ; copyright notice. ;-- ; Modifications: ; 20-DEC-1993: added check to determine if CLI is DCL ; 20-DEC-1993: added check to determine if process has a CLI symbol table ; (eg. an image run $ RUN/DET ) ; 11-JAN-1994: remove unnecessary code to deallocate ACB if the process ; does not exist. ; prevent routine from trashing the first 256 bytes of common ; are used by RTLs. ; 12-JAN-1994: modify code to use the user "core-common" pages in p1 space ; instead of the DEC "core-common" pages to avoid conflicts ; with LIB${PUT/GET}_COMMON and BASIC 'chained' programs. ; 19-JAN-1994: add code to determine if the current process has access ; to the target process. GROUP allows access to processes ; in the same group; WORLD allows access to all processes. ; SYMBOL may now be installed with CMKRNL privilege with- ; out compromising UIC based security. ; 20-JAN-1994: add code to report operational status to the originating ; process. process now waits on an event flag for status. ; 25-JAN-1994: add code to support creation of BINARY symbols. ; 27-JAN-1994: add checks for undefined and ambiguous symbols. ; 06-FEB-1994: add hooks to SYMCLUSTER VAXcluster support routine ; Version V3: ----------------------------------------------------------- ; 24-FEB-1994: V3 Restructuring. Functions moved to SYSMBOL$AST_LEI in ; anticipation of supporting OpenVMS/AXP. All previous ; functionality maintained. ; 13-MAR-1993 added overlooked check for target suspension ;-- .SBTTL DECLARATIONS .LIBRARY "SYS$LIBRARY:LIB.MLB" ; look here during assembly $ACBDEF ; AST control block def's $DSCDEF ; VMS descriptor type/class def's $DYNDEF ; dynamic data structure codes $IPLDEF ; Interrrupt priority def's $PCBDEF ; Process control block structure def's $PHDDEF ; Process header block def's $PRIDEF ; process priority def's $PRVDEF ; Processor privilege quadword def's $PSLDEF ; Processor status longword field def's $CLIDEF ; CLI service request codes $CLIMSGDEF ; CLI error message codes $CLISERVDEF ; CLI interface definitions $LIBDEF ; LIB RTL error codes. $SSDEF ; system service error definitions ;---------------------------------------------------------------------------- .SBTTL SYMBOL ACB extentions ;++ ; Relative offset definitions for data extentions common to SYMBOL DISPLAY, ; SYMBOL SET and SYMBOL DELETE kernel mode ASTs. ;-- $OFFSET ACB$K_LENGTH,POSITIVE,<- ,- ; start of kernel AST data area ,- ; event flag to set when ASTs complete ,- ; adr of original process status arg ,- ; image count at time of request ,- ; UIC/access mask to target process ,- ; size of kernel AST data area > ;++ ; Relative offset definitions for eXtended kernel mode data requirements of ; the SYMBOL DISPLAY kernel mode AST. ;-- $OFFSET K_SIZE,POSITIVE,<- ,- ; start of kernel AST eXtention data area ,- ; adr of buffer on origin process p0 space ,- ; SYMBOL Table descriptor of target process ,- ; SYMBOL Table descriptor size ,- ; SYMBOL Table descriptor address ,- ; Non-paged pool buffer descriptor ,- ; Non-paged pool buffer descriptor size ,- ; Non-paged pool buffer descriptor address ,- ; offset to symbol table copy ,- ; size of this area > ;++ ; Relative offset definitions for the normal supervisor mode data requirements ; of SYMBOL SET and SYMBOL DELETE piggyback special-K and supervisor mode ASTs. ;-- $OFFSET K_SIZE,POSITIVE,<- ,- ; start of superv. AST data area ,-; CLI callback block ,- ; storage for binary value ,- ; CLI function to be performed ,- ; symbol listhead address ,- ; offset to symbol info ,- ; size of this area > ;++ ; Relative offset definitions for storage cells which contain the addresses ; of the AST routines in the paged writeable segment of the SYMBOL$AST_LEI. ;-- $OFFSET 0,POSITIVE,<- ,- ,- ,- > ;---------------------------------------------------------------------------- .NTYPE ...ON_ALPHA...,R31 .IIF EQ,<...ON_ALPHA...@-4&^XF>-5, ALPHA=0 .IIF DF,ALPHA, .DISABLE FLAGGING ;---------------------------------------------------------------------------- .MACRO INVALID TABLE,CHAR __SAVCTR=. .='TABLE'+^a\CHAR\ .BYTE -1 .=__SAVCTR .ENDM INVALID ;---------------------------------------------------------------------------- .PSECT $$DATA,WRT,NOEXE,LONG SYMCHR: .BLKB 256 INVALID SYMCHR, INVALID SYMCHR, INVALID SYMCHR,<"> INVALID SYMCHR,<#> INVALID SYMCHR,<(> INVALID SYMCHR,<)> INVALID SYMCHR,<+> INVALID SYMCHR,<,> INVALID SYMCHR,<-> INVALID SYMCHR,<.> INVALID SYMCHR, INVALID SYMCHR,<;> INVALID SYMCHR,^// INVALID SYMCHR, INVALID SYMCHR,<@> INVALID SYMCHR,<[> INVALID SYMCHR,<]> INVALID SYMCHR,<^> SYM1CHR: .ASCII /ABCDEFGHIJKLMNOPQRSTUVWXYZ_$/ SYM1CHR_LEN= .-SYM1CHR .ALIGN LONG K_ARGS: .LONG 7 EFN: .BLKL 1 ; EFN to wait on... FNX: .BLKL 1 ; CLI callback func PID: .BLKL 1 ; PID of process to be targeted STS: .ADDRESS STATUS ; status of operation (like IOSB) SYM: .ADDRESS NAMDESC VAL: .ADDRESS VALDESC BIN: .BLKL 1 _EFN = EFN-K_ARGS _FNX = FNX-K_ARGS _PID = PID-K_ARGS _STS = STS-K_ARGS _SYM = SYM-K_ARGS _VAL = VAL-K_ARGS _BIN = BIN-K_ARGS STATUS: .QUAD 0 ; status of operation in remote process context IDENT_BUFF: .LONG !,0 NAMDESC: .LONG !,0 VALDESC: .LONG !,0 IDENT: .ASCID /IDENT/ SYMBOL: .ASCID /SYMBOL/ VALUE: .ASCID /VALUE/ DELQUAL: .ASCID /DELETE/ LCLQUAL: .ASCID /LOCAL/ NUMERIC: .ASCID /BINARY/ ;---------------------------------------------------------------------------- .PSECT $$CODE_RO,PIC,GBL,SHR,NOWRT,EXE,LONG .ENTRY SYMDELSET,^M<> PUSHAQ IDENT_BUFF PUSHAQ IDENT_BUFF PUSHAQ IDENT CALLS #3,G^CLI$GET_VALUE ; get the user's PID PUSHL #1 PUSHL #4 PUSHAL PID PUSHAQ IDENT_BUFF CALLS #4,G^OTS$CVT_TZ_L ; convert the PID to hex BLBS R0,10$ ; branch if valid PID RET 10$: CMPZV #PCB$V_EPID_NODE_IDX,- ; using no PID/on local node/ #,PID,#0 BEQL 20$ ; or invalid pid CMPZV #PCB$V_EPID_NODE_IDX,- ; is this process on this ... #,- PID,@#SCH$GW_LOCALNODE ; cluster node? BEQL 20$ ; PID is on the local node PUSHL PID CALLS #1,SYMCLUSTER ; send command to remote node RET 20$: PUSHAQ NAMDESC PUSHAQ NAMDESC PUSHAQ SYMBOL CALLS #3,G^CLI$GET_VALUE ; get the symbol name BLBS R0,30$ RET 30$: CMPW #255,NAMDESC ; is symbol right size? BGEQ 40$ ; yes... MOVL #CLI$_SYMLNG,R0 ; tell user SYMLNG RET 40$: LOCC @NAMDESC+4,#SYM1CHR_LEN,- ; does symbol start SYM1CHR ; with right character? BNEQ 50$ MOVL #CLI$_IVSYMB,R0 ; tell user IVSYMB RET 50$: SCANC NAMDESC,@NAMDESC+4,- ; any illegal characters SYMCHR,#-1 ; in symbol name? BEQL 60$ MOVL #SS$_BADPARAM,R0 ; tell user BADPARAM RET 60$: PUSHAQ DELQUAL ; is this a delete function? CALLS #1,G^CLI$PRESENT BLBS R0,70$ ; /DELETE present MOVZWL #CLI$K_DEFGLOBAL,FNX ; service to be performed: ; global symbol definition PUSHAQ LCLQUAL ; is this a local function? CALLS #1,G^CLI$PRESENT BLBC R0,80$ ; /SET/LOCAL not present MOVZWL #CLI$K_DEFLOCAL,FNX ; service to be performed: ; local symbol definition BRB 80$ 70$: MOVZWL #CLI$K_DELEGBL,FNX ; service to be performed: ; global symbol deletion PUSHAQ LCLQUAL ; is this a local function? CALLS #1,G^CLI$PRESENT BLBC R0,100$ ; /DELETE/LOCAL no present MOVZWL #CLI$K_DELELCL,FNX ; service to be performed: ; local symbol deletion BRB 100$ 80$: PUSHAQ VALDESC PUSHAQ VALDESC PUSHAQ VALUE CALLS #3,G^CLI$GET_VALUE ; get the equivalence string BLBS R0,90$ RET 90$: PUSHAQ NUMERIC ; is this an integer symbol? CALLS #1,G^CLI$PRESENT BLBC R0,100$ ; /BINARY not present MNEGW #1,FNX+2 ; signify binary function PUSHL #1 PUSHL #4 PUSHAL BIN PUSHAQ VALDESC CALLS #4,G^OTS$CVT_TI_L ; convert string to integer BLBS R0,100$ ; an invalid PID RET ;++ ; Build a CLI service block. Service code specifies scope of symbol. ;-- 100$: PUSHAL EFN CALLS #1,G^LIB$GET_EF ; get an event flag number $CMKRNL_S ROUTIN=SYM_DELSET,- ; goto kernel mode ARGLST=K_ARGS ; to do the deed BLBS R0,110$ RET 110$: $SYNCH_S EFN=EFN,- IOSB=STATUS ; wait here until ASTs complete MOVL STATUS,R0 ; return the error status. RET ;final exit point ;---------------------------------------------------------------------------- .ENTRY SYM_DELSET,^M .IF NDF ALPHA PUSHAB 50$ ; push adr of routine end PUSHAB 10$ ; push adr of routine start MOVAB (SP),R0 ; save adr of INADR arg $LKWSET_S INADR=(R0) ; lock WS/no paging @IPL$_SCHED BLBS R0,10$ ; locked down tight? RET ; no... tell user. .ENDC 10$: CLRL @_STS(AP) ; initialize status quadword $CLREF_S EFN=_EFN(AP) ; and clear the event flag CLRL R7 ; initial UIC mask register EXTV #PRV$V_GROUP,#1,- ; does process have GROUP priv? PCB$Q_PRIV(R4),R0 MOVW R0,R7 ; set mask accordingly EXTV #PRV$V_WORLD,#1,- ; does process have WORLD priv? PCB$Q_PRIV(R4),R0 BISL2 R0,R7 ; set mask accordingly BISL2 PCB$L_UIC(R4),R7 ; complete UIC access mask MOVL _PID(AP),R2 ; get EPID to find PCB .IIF DF,ALPHA, $LOCK_PAGE 40$ ; use $LOCK_PAGE macro on AXP LOCK LOCKNAME=SCHED ; acquire the sched spinlock MOVL #SS$_NONEXPR,R10 ; assume non-existant process MOVL R2,R0 ; get the passed EPID BNEQ 20$ ; was a EPID specified? MOVL PCB$L_EPID(R4),R0 ; use this process's EPID 20$: .IF DF ALPHA JSB G^EXE$CVT_EPID_TO_PCB ; get PCB associated with EPID TSTL R0 ; did we get a PCB? .IF_FALSE JSB G^EXE$EPID_TO_PCB ; get PCB associated with EPID .ENDC BEQL 30$ ; no PCB? quit... MOVL PCB$L_PID(R0),R6 ; save IPID in R6 for later CMPL R6,@#SCH$GL_SWPPID ; check if it's the SWAPPER BLEQ 30$ ; oops... it is the swapper MOVL #SS$_SUSPENDED,R10 ; assume target is suspended BBS #PCB$V_SUSPEN,PCB$L_STS(R0),30$ ; oops... it must be MOVL #SS$_NORMAL,R10 ; assume we have the privs. BICL3 R7,PCB$L_UIC(R0),R0 ; are we privy to this process? BEQL 30$ ; yes! off we go! MOVL #SS$_NOWORLD,R10 ; assume world priv needed! EXTZV #16,#16,R0,R0 ; was it outside group access? BNEQ 30$ ; branch if outside group access? MOVL #SS$_NOGROUP,R10 ; obviously outside member access! 30$: UNLOCK LOCKNAME=SCHED ; release sched spinlock MOVL R10,R0 ; retreive status code .IIF DF,ALPHA, $UNLOCK_PAGE ; use $UNLOCK_PAGE macro on AXP BLBS R0,50$ ; was routine successful? 40$: RET 50$: MOVL #,R9 ; fixed ACB extension length... ADDW2 @_SYM(AP),R9 ; plus symbol name length ... ADDW2 @_VAL(AP),R9 ; and value string length MOVL #SS$_INSFMEM,R0 ; assume common area is not big enuf CMPL @#CTL$GQ_COMMON,R9 ; is this common area big enuf? BLSS 60$ JSB FIND_LDRIMG ; find SYMBOL_LEI LDRIMG BLBC R0,60$ ; trouble?... SETIPL IPL=#IPL$_ASTDEL ADDL3 #K_SIZE,R9,R1 ; grab space for acb and data JSB G^EXE$ALONONPAGED ; ask for R1 bytes of NPP BLBS R0,70$ ; get out if we couldn't 60$: RET ; get it ;++ ; Now fill in the allocated NPP. Create an ACB for a Piggyback Special ; Kernel mode AST riding on the back of a normal supervisor mode AST. ; The code (the ASTs) is copied into the remaining allocation region. ;-- 70$: MOVW R1,ACB$W_SIZE(R2) ; size of allocation MOVB #DYN$C_ACB,ACB$B_TYPE(R2) ; type as an ACB MOVL R6,ACB$L_PID(R2) ; who's the victim MOVL PCB$L_PID(R4),ACB$L_ASTPRM(R2) ; originator's IPID MOVB #,- ; it's a SUPER mode AST ACB$B_RMOD(R2) ; with a piggyback KAST MOVL PKAST_ROUTINE(R3),ACB$L_KAST(R2); start of PKAST in LEI MOVL SUPRV_ROUTINE(R3),ACB$L_AST(R2) ; start of SAST in LEI MOVL _EFN(AP),EF_NUM(R2) ;\ MOVL _FNX(AP),FUNCTN(R2) ; move passed arglst data to MOVL _STS(AP),STSADR(R2) ; ACB's local storage block MOVL _BIN(AP),BINARY(R2) ;/ MOVL R7,UICMSK(R2) ; save the UIC check mask MOVZBL #CLI$K_CLISERV,- CALBCK+CLI$B_RQTYPE(R2) ; specify a CLI service MOVW _FNX(AP),- CALBCK+CLI$W_SERVCOD(R2); type of service to do MOVL @#CTL$GL_PHD,R3 ; get adr of process's header MOVL PHD$L_IMGCNT(R3),- ; store current image count SANITY(R2) ; for future sanity check MOVZWL @_SYM(AP),- ; move length of symbol name to CALBCK+CLI$Q_NAMDESC(R2); ACB's CALBCK storage block MOVZWL @_VAL(AP),- ; move length of value string to CALBCK+CLI$Q_VALDESC(R2); ACB's CALBCK storage block CLRQ CALBCK+CLI$Q_TABDESC(R2); zero CALBCK TABDESC field PUSHL R2 ; save the address of the ACB MOVQ @_SYM(AP),R0 ; get the symbol name descr. MOVC3 R0,(R1),SYMINF(R2) ; copy symbol to ACB's storage MOVQ @_VAL(AP),R0 ; get the value string descr. MOVC3 R0,(R1),(R3) ; copy value to ACB's storage POPL R5 ; recover ACB's address MOVL #PRI$_TICOM,R2 ; give biggy boost JSB G^SCH$QAST ; queue AST RET ; .END ;SYMDELSET