.title PRV - Privilege manager .ident 'PRV V2.0' .link "sys$system:sys.stb"/selective_search .library "sys$share:lib" ; .library "mar:always" ; ; Program: PRV.MAR V2.0 ; ; Author: David G. North, CCP ; 1333 Maywood Ct ; Plano, Texas 75023-1914 ; (214) 902-3957 ; ; Date: 90.11.16 ; ; Revisions: ; Who Date Description ; D.North 901116 DECUS release (Fall 90) ; D.North 911113 DECUS release (Fall 91) ; ; License: ; Ownership of and rights to these programs is retained by the author(s). ; Limited license to use and distribute the software in this library is ; hereby granted under the following conditions: ; 1. Any and all authorship, ownership, copyright or licensing ; information is preserved within any source copies at all times. ; 2. Under absolutely *NO* circumstances may any of this code be used ; in any form for commercial profit without a written licensing ; agreement from the author(s). This does not imply that such ; a written agreement could not be obtained. ; 3. Except by written agreement under condition 2, source shall ; be freely provided with all binaries. ; 4. Library contents may be transferred or copied in any form so ; long as conditions 1, 2, and 3 are met. Nominal charges may ; be assessed for media and transferral labor without such charges ; being considered 'commercial profit' thereby violating condition 2. ; ; Warranty: ; These programs are distributed in the hopes that they will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ; or FITNESS FOR A PARTICULAR PURPOSE. ; $acbdef ;AST control block definitions $chfdef ;Condition handling facility definitions $dyndef ;Dynamic block type definitions $jpidef ;GETJPI item code definitions $libdef ;LIB$ routine return codes $pcbdef ;PCB offset definitions $phddef ;PHD offset definitions $pridef ;Priority class constants $prvdef ;Privilege bit definitions $psldef ;Processor status longword definitions $rmsdef ;RMS return codes etc. $ssdef ;System return codes $stsdef ;Message bit definitions $tpadef ;LIB$TPARSE table generation junk .psect $astcode,pic,shr,rd,nowrt,noexe .psect $local,pic,noshr,noexe,rd,wrt,long .psect $rodata,pic,noshr,noexe,rd,nowrt,long .psect $tpastuff,pic,shr,noexe,rd,nowrt .psect $code,pic,shr,exe,rd,nowrt .psect $tpastuff ;++ ; TPA Parse table for command line ; General command syntax: ; $VERB [[+|-]priv[,[+|-]priv...][/LIST][/IDENT=nnn][/AUTHORIZED] ; [/CURRENT][/FULL][/EXECUTIVE] ; Initial state is to enable listed privileges ; No privileges to affect implies list [specified] privileges ; A '-' means begin disabling privileges listed ; A '+' means begin enabling privileges listed ; Classes 'ALL', 'MINIMUM', 'PRIV', 'BASIC' are provided ; /IDENT targets another process, current PID is ignored ; /EXECUTIVE uses $CMEXEC to set lcl/lst privs if needed ; /AUTHORIZED affects authorized privilege mask ; /CURRENT affects current privilege mask ; /LIST lists resultant privilege mask ; /FULL includes privilege descriptions ; ; Any change mode to kernel code will request confirmation first. ; Note also that current privileges appear too transient for changes ; to be of much use for the target process. ; ; Additional note: if the user defines the symbol NOCMKRNL during ; assembly, use of $CMKRNL calls will be denied... this is useful for ; creating an executable which is to run in a production environment. ; ;-- ; $INIT_STATE state_table, key_table ; $STATE [label] ; $TRAN type[,label][,action][,mask][,msk-adr][,argument] ; $END_STATE ; comma = ^a/,/ ;continuation of last operation (list) plus = ^a/+/ ;begin add privileges minus = ^a/-/ ;begin remove privileges $INIT_STATE sttbl,kytbl ; Please note that all definitions are in alphabetical order... ; This is necessary for LIB$TPARSE to correctly detect ambiguities. ; Main parse state - look for a switch, a null string, or fall thru to privname $STATE start $TRAN !_switch,start ;grab a switch $TRAN TPA$_EOS,TPA$_EXIT,kerchunkit ;this is a LIST op. $TRAN TPA$_LAMBDA ;get a privilege name otherwise ; State to accept ON/OFF flag or privilege $STATE _prvcmd $TRAN !_prvnam,_chklst ;get a privilege name $TRAN plus,,setdir,,,0 ;or a '+'privname $TRAN minus,,setdir,,,1 ;or a '-'privname ; Now... got an ON/OFF flag... must force caller to say a privilege name $STATE $TRAN !_prvnam ;force a privilege name ; Now... see if a list is being used, or if end of string is reached $STATE _chklst $TRAN comma,_prvcmd ;comma... do it again $TRAN TPA$_EOS,TPA$_EXIT,kerchunkit ;process end-of-line ; Privilege name transitions... note special constants to indicate class actions PRV_C_ALL = ^x80 PRV_C_PRIV = ^x81 PRV_C_MIN = ^x82 PRV_C_BASIC = ^x83 $STATE _prvnam $TRAN 'ACNT',,setprv,,,PRV$V_ACNT $TRAN 'ALL',,setprv,,,PRV_C_ALL $TRAN 'ALLSPOOL',,setprv,,,PRV$V_ALLSPOOL $TRAN 'ALTPRI',,setprv,,,PRV$V_SETPRI $TRAN 'BASIC',,setprv,,,PRV_C_BASIC $TRAN 'BUGCHK',,setprv,,,PRV$V_BUGCHK $TRAN 'BYPASS',,setprv,,,PRV$V_BYPASS $TRAN 'CMEXEC',,setprv,,,PRV$V_CMEXEC $TRAN 'CMKRNL',,setprv,,,PRV$V_CMKRNL $TRAN 'DETACH',,setprv,,,PRV$V_DETACH $TRAN 'DIAGNOSE',,setprv,,,PRV$V_DIAGNOSE $TRAN 'DOWNGRADE',,setprv,,,PRV$V_DOWNGRADE $TRAN 'EXQUOTA',,setprv,,,PRV$V_EXQUOTA $TRAN 'GROUP',,setprv,,,PRV$V_GROUP $TRAN 'GRPNAM',,setprv,,,PRV$V_GRPNAM $TRAN 'GRPPRV',,setprv,,,PRV$V_GRPPRV $TRAN 'LOG_IO',setprv,,,PRV$V_LOG_IO $TRAN 'MINIMUM',,setprv,,,PRV_C_MIN $TRAN 'MOUNT',,setprv,,,PRV$V_MOUNT $TRAN 'NETMBX',,setprv,,,PRV$V_NETMBX $TRAN 'NOACNT',,setprv,,,PRV$V_ACNT $TRAN 'OPER',,setprv,,,PRV$V_OPER $TRAN 'PFNMAP',,setprv,,,PRV$V_PFNMAP $TRAN 'PHY_IO',,setprv,,,PRV$V_PHY_IO $TRAN 'PRMCEB',,setprv,,,PRV$V_PRMCEB $TRAN 'PRMGBL',,setprv,,,PRV$V_PRMGBL $TRAN 'PRMMBX',,setprv,,,PRV$V_PRMMBX $TRAN 'PRIVILEGED',,setprv,,,PRV_C_PRIV $TRAN 'PSWAPM',,setprv,,,PRV$V_PSWAPM $TRAN 'READALL',,setprv,,,PRV$V_READALL $TRAN 'SECURITY',,setprv,,,PRV$V_SECURITY $TRAN 'SETPRI',,setprv,,,PRV$V_SETPRI $TRAN 'SETPRV',,setprv,,,PRV$V_SETPRV $TRAN 'SHARE',,setprv,,,PRV$V_SHARE $TRAN 'SHMEM',,setprv,,,PRV$V_SHMEM $TRAN 'SYSGBL',,setprv,,,PRV$V_SYSGBL $TRAN 'SYSLCK',,setprv,,,PRV$V_SYSLCK $TRAN 'SYSNAM',,setprv,,,PRV$V_SYSNAM $TRAN 'SYSPRV',,setprv,,,PRV$V_SYSPRV $TRAN 'TMPMBX',,setprv,,,PRV$V_TMPMBX $TRAN 'UPGRADE',,setprv,,,PRV$V_UPGRADE $TRAN 'VOLPRO',,setprv,,,PRV$V_VOLPRO $TRAN 'WORLD',,setprv,,,PRV$V_WORLD $STATE _lclsw $TRAN !_switch,_lclsw $TRAN TPA$_LAMBDA,TPA$_EXIT ; Switch parsing states SW_V_LIST = ^x0 SW_V_FULL = ^x1 SW_V_CURRENT = ^x2 SW_V_AUTHORIZED = ^x3 SW_V_IDENT = ^x4 SW_V_EXEC = ^x5 SW_M_LIST = ^x00000001 SW_M_FULL = ^x00000002 SW_M_CURRENT = ^x00000004 SW_M_AUTHORIZED = ^x00000008 SW_M_IDENT = ^x00000010 SW_M_EXEC = ^x00000020 ; force a '/' switch character $STATE _switch $TRAN '/' ; accept switch keywords $STATE $TRAN 'AUTHORIZED',TPA$_EXIT,setsw,,,SW_V_AUTHORIZED $TRAN 'CURRENT',TPA$_EXIT,setsw,,,SW_V_CURRENT $TRAN 'EXECUTIVE',TPA$_EXIT,setsw,,,SW_V_EXEC $TRAN 'FULL',TPA$_EXIT,setsw,,,SW_V_FULL $TRAN 'IDENTIFICATION',_ident,setsw,,,SW_V_IDENT $TRAN 'LIST',TPA$_EXIT,setsw,,,SW_V_LIST ; identification requires a '=' 'PID' syntax... force '=' $STATE _ident $TRAN '=' ; force hexadecimal PID number (no other validation...up to program) $STATE $TRAN TPA$_HEX,TPA$_EXIT,setid $END_STATE ;----------------------END STATE TABLE------------------------------------------ .psect $local ;++ ; *** Local data storage, macros, etc. ;-- .macro describe,name=,desc= .if ndf,__DESCCNT __DESCCNT=0 .macro __tagit lbl,num 'lbl''num': .endm __tagit .macro __point lbl,num .address 'lbl''num' .endm __point .iff __DESCCNT = __DESCCNT + 1 .endc .save_psect .psect test __tagit <__DESC>,\__DESCCNT .ascid ~name~ .restore_psect __point <__DESC>,\__DESCCNT __DESCCNT = __DESCCNT + 1 .save_psect .psect test __tagit <__DESC>,\__DESCCNT .ascid ~desc~ .restore_psect __point <__DESC>,\__DESCCNT .endm ;---------------------END MACRO DEFINITIONS------------------------------------- badmsg: describe dsctab: describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , describe , .long 0,0,0,0 ;two unused priv bits describe , TBLLEN = <.-dsctab>/8 argblk: .blkb TPA$K_LENGTH0 ;space for argblk faob1: .blkq .udesc faob2: .blkq .udesc prvnam: .udesc myipid: .long 0 ;place for this process ID mypid: .long 0 ;place for this process ID jpilst: .long JPI$_PID@16!4,mypid,0,0 allprv: ;dummy label to reference with MASKID curprv: .blkq defprv: .blkq autprv: .blkq jpiprv: .long JPI$_CURPRIV@16!8,curprv,0 .long JPI$_PROCPRIV@16!8,defprv,0 .long JPI$_AUTHPRIV@16!8,autprv,0,0 jpiflg: .blkl MSK_C_CURR = 0 MSK_C_DFLT = 1 MSK_C_AUTH = 2 MSK_V_REMO = 2 MSK_M_REMO = 4 pid: .long 0 ;default to myself flags: .long 0 maskid: .long 0 ;Mask ID to affect (0=cur,1=dflt,2=aut) status: .long 0 ;completion status of set operation iosb: .quad ;trash iosb all_q_prv: .long -1,-1 prv_q_prv: .long ^x300D2025,^x40 ;cmk,sysnam,det,setpri,worl,oper,exq, ; sysprv,byp,secur min_q_prv: .long ^x00004000,^x8 ;readall,setprv bas_q_prv: .long ^x00108000,^x0 ;tmpmbx,netmbx set_q_prv: .quad rmv_q_prv: .quad setresflg: .long 0 prvdsc: .address curdsc,defdsc,autdsc curdsc: .ascid /Current/ defdsc: .ascid /Default/ autdsc: .ascid /Authorized/ yesdsc: .ascid /YES/ .psect $astcode ;++ ; Begin AST delivery definitions and code ;-- $DEFINI POK $DEF POK_B_ACB .blkb ACB$K_LENGTH ;space for ACB $DEF POK_Q_ENBMSK .blkq ;place for enable privilege msk $DEF POK_Q_DISMSK .blkq ;place for disable privilege msk $DEF POK_L_STATUS .blkl ;return status $DEF POK_B_INTLK .blkb ;spinlock $DEF POK_B_CODE .blkb 512 ;rest is code POK_K_LENGTH = . $DEFEND POK ASSUME POK_B_ACB EQ 0 ; ACB must be the first thing in the block! .IIF NDF,NOCMKRNL, .PRINT 999 ; KERNEL code enabled .IIF DF,NOCMKRNL, .PRINT 999 ; KERNEL code disabled code_begin: .word ^m movl 4(AP),r6 ;AST parameter is ACB address... callg (AP),b^40$ ;fake a call movl r0,POK_L_STATUS(r6) ;return completion code bneq 10$ ;non-zero completion decl POK_L_STATUS(r6) ;show zero return as -1 10$: subl #40$-20$,SP ;make space for code movc3 #40$-20$,b^20$,(SP) ;move code to stack movab (SP),-(SP) ;shove the address onto stack movzbl #SS$_NORMAL,r0 ;issue normal return rsb ;return to code on stack 20$: bbssi #0,POK_B_INTLK(r6),30$ ;(onstack) set INTLK complete 30$: ret ;(onstack) ret from AST 40$: .word ^m<> movaw b^99$,(FP) ;set exception handler clrl -(SP) ;prvprv movzbl #1,-(SP) ;prmflg pushaq POK_Q_DISMSK(r6) ;prvadr clrl -(SP) ;enbflg (Disable) calls #4,@#SYS$SETPRV ;$setprv blbc r0,50$ ;return bad status pushaq POK_Q_DISMSK(r6) ;prvprv movzbl #1,-(SP) ;prmflg pushaq POK_Q_ENBMSK(r6) ;prvadr movzbl #1,-(SP) ;enbflg (Enable) calls #4,@#SYS$SETPRV ;$setprv 50$: ret 99$: .word ^m movl CHF$L_SIGARGLST(AP),r4 ;signal argument list cmpl CHF$L_SIG_NAME(r4),#SS$_UNWIND ;is this an unwind??? beql 100$ ;yep... keep on unwinding $UNWIND_S ;wipeout movl #SS$_UNWIND,r0 100$: ret code_end: code_length = code_end - code_begin .psect $code ;++ ; Begin main CODE section ;-- ;+ ; TPARSE action routines ;- ; Set a particular privilege operation/bit .entry setprv,^m movaq set_q_prv,r0 movaq rmv_q_prv,r1 blbc setresflg,10$ movaq rmv_q_prv,r0 movaq set_q_prv,r1 10$: movl TPA$L_PARAM(AP),r2 cmpl r2,#TBLLEN bgequ 20$ bbss r2,(r0),12$ 12$: bbsc r2,(r1),15$ 15$: brw 30$ ; these are class operations 20$: case r2,<2000$,2010$,2020$,2030$>,base=#PRV_C_ALL,type=w $exit_s - code = #SS$_BUGCHECK ;something stupid's happened 2000$: ;PRV_C_ALL = ^x80 bisl all_q_prv,(r0) bisl all_q_prv+4,4(r0) bicl all_q_prv,(r1) bicl all_q_prv+4,4(r1) 2010$: ;PRV_C_PRIV = ^x81 bisl prv_q_prv,(r0) bisl prv_q_prv+4,4(r0) bicl prv_q_prv,(r1) bicl prv_q_prv+4,4(r1) 2020$: ;PRV_C_MIN = ^x82 bisl min_q_prv,(r0) bisl min_q_prv+4,4(r0) bicl min_q_prv,(r1) bicl min_q_prv+4,4(r1) 2030$: ;PRV_C_BASIC = ^x83 bisl bas_q_prv,(r0) bisl bas_q_prv+4,4(r0) bicl bas_q_prv,(r1) bicl bas_q_prv+4,4(r1) 30$: movzbl #SS$_NORMAL,r0 ;force OK return ret ; Set privilege SET/RMV flag direction .entry setdir,^m movl TPA$L_PARAM(AP),setresflg movzbl #SS$_NORMAL,r0 ;force OK return ret ; Set a switch bit .entry setsw,^m bbss TPA$L_PARAM(AP),flags,10$ 10$: movzbl #SS$_NORMAL,r0 ;force OK return ret ; Set a process id .entry setid,^m movl TPA$L_NUMBER(AP),pid movzbl #SS$_NORMAL,r0 ;force OK return ret ; Perform completion processing .entry kerchunkit,^m clrl status ;no status yet bicl3 #^c,flags,r0 cmpl r0,#SW_M_CURRENT!SW_M_AUTHORIZED bneq nocnf1 ;No /CURRENT /AUTHORIZED conflict PRINTF movzwl #SS$_ABORT,status brw ekerch nocnf1: bbc #SW_V_IDENT,flags,20$ movl pid,r0 jsb @#EXE$EPID_TO_IPID bneq 10$ movl SS$_NONEXPR,status ;bad pix... not local node... etc. brw ekerch 10$: cmpl r0,myipid ;see if IPID's match bneq 20$ bbcc #SW_V_IDENT,flags,20$ ;clear IDENT flag for same PID 20$: bbs #SW_V_IDENT,flags,30$ ;If IDENT specified, don't set self PID movl mypid,pid ;set self PID 30$: bicl3 #^c,flags,r0 beql nocnf2 bicl3 #^c,flags,r0 cmpl r0,#SW_M_CURRENT!SW_M_IDENT beql nocnf2 PRINTF movl #SS$_ABORT,status brw ekerch nocnf2: bbc #SW_V_FULL,flags,10$ bbss #SW_V_LIST,flags,10$ ;force /LIST for /FULL 10$: movl #MSK_C_DFLT,maskid ;assume default mask bbc #SW_V_CURRENT,flags,20$ movl #MSK_C_CURR,maskid ;set current mask brb 30$ 20$: bbc #SW_V_AUTHORIZED,flags,30$ movl #MSK_C_AUTH,maskid ;set authorized mask 30$: movq set_q_prv,r0 bneq 40$ movq rmv_q_prv,r0 bneq 40$ bisl #SW_M_LIST,flags ;Turn on LIST bit bsbw setimgprv ;get image privs if possible bsbw lstprv ;Perform list operation brw ekerch ;leave 40$: movl maskid,r0 bbc #SW_V_IDENT,flags,60$ bbcc #SW_V_EXEC,flags,50$ ;clr /EXEC for remote tasks 50$: bisl #MSK_M_REMO,r0 60$: bsbw setimgprv ;get image privs if possible case r0,<200$,100$,110$,200$,120$,130$,110$,200$> brb 200$ ;bugit 100$: brw lclsetdflt ;LOCAL SET DEFAULT PRIVS 110$: brw allsetauth ;ALL SET AUTH PRIVS 120$: brw rmtsetcurr ;REMOTE SET CURRENT 130$: brw rmtsetdflt ;REMOTE SET DEFAULT 200$: movl #SS$_BUGCHECK,status ;BUG code brw ekerch exception: ;Do *NOT* make this global! .word ^m movl CHF$L_SIGARGLST(AP),r4 ;signal argument list cmpl CHF$L_SIG_NAME(r4),#SS$_UNWIND ;is this an unwind??? beql 10$ ;yep... keep on unwinding movl CHF$L_MCHARGLST(AP),r5 ;get mechanism list address movl CHF$L_SIG_NAME(r4),CHF$L_MCH_SAVR0(r5) ;copy signal name $UNWIND_S ;Wipe out gracefully movl #SS$_CONTINUE,r0 ;Continue from exception 10$: ret ;return to caller of excepted procedure lclsetdflt: ; 7. COND lcl set dflt: perform local set operation, list denials, exit $SETPRV_S - enbflg = #0,- prmflg = #1,- prvadr = rmv_q_prv $SETPRV_S - enbflg = #1,- prmflg = #1,- prvadr = set_q_prv movl r0,status blbc r0,10$ cmpl r0,#SS$_NOTALLPRIV beql 30$ 10$: bsbw lstprv ;Perform list operation blbs status,20$ bsbw dnyprv ;List denied privileges 20$: brw ekerch ;leave 30$: movl #SS$_NOSETPRV,status bbc #SW_V_EXEC,flags,10$ clrl -(SP) ;prvprv movzbl #1,-(SP) ;prmflg pushaq set_q_prv ;prvadr movzbl #1,-(SP) ;enbflg calls #4,b^40$ movl r0,status brw 10$ 40$: .word 0 $CMEXEC_S - routin = @#SYS$SETPRV,- arglst = (AP) cmpl r0,#SS$_NOPRIV bneq 50$ movl #SS$_NOCMEXEC,r0 50$: ret allsetauth: ; 8: COND all set auth: confirm, $CMKRNL, exit bsbw confirm .IF NDF,NOCMKRNL $CMKRNL_S - routin = 10$ .IFF movl #SS$_KERNELINV,r0 ;ABORT operation .ENDC movl r0,status bsbw lstprv ;Perform list operation brw ekerch ;leave 10$: .word ^m movaw exception,(FP) ;set exception handler movl pid,r0 ;get process ID to munge bneq 20$ ;It *was* specified movl PCB$L_EPID(r4),r0 ;Get our PID if passed 0 20$: jsb g^EXE$EPID_TO_IPID ;Change to IPID beql 30$ ;Not valid cmpl r0,g^SCH$GL_SWPPID ;SWAPPER illegal too beql 30$ ;SWAPPER specified jsb g^EXE$IPID_TO_PCB ;Get PCB address beql 30$ ;PCB translation failure brb 40$ 30$: movl #SS$_NONEXPR,r0 ret 40$: movl r0,r4 ;set PCB addr in R4 bbc #PCB$V_RES,PCB$L_STS(r4),30$ ;issue NONEXPR for SWAPO movl PCB$L_PHD(r4),r5 ;get PHD bicl rmv_q_prv,PHD$Q_AUTHPRIV(r5) ;remove 1 bicl rmv_q_prv+4,PHD$Q_AUTHPRIV+4(r5);remove 2 bisl set_q_prv,PHD$Q_AUTHPRIV(r5) ;set 1 bisl set_q_prv+4,PHD$Q_AUTHPRIV+4(r5);set 2 movzbl #SS$_NORMAL,r0 ret rmtsetcurr: ; 9: COND rmt set curr: confirm, $CMKRNL, exit bsbw confirm .IF NDF,NOCMKRNL $CMKRNL_S - routin = 10$ .IFF movl #SS$_KERNELINV,r0 ;ABORT operation .ENDC movl r0,status bsbw lstprv ;Perform list operation brw ekerch ;leave 10$: .word ^m movaw exception,(FP) ;set exception handler movl pid,r0 ;get process ID to munge bneq 20$ ;It *was* specified movl PCB$L_EPID(r4),r0 ;Get our PID if passed 0 20$: jsb g^EXE$EPID_TO_IPID ;Change to IPID beql 30$ ;Not valid cmpl r0,g^SCH$GL_SWPPID ;SWAPPER illegal too beql 30$ ;SWAPPER specified jsb g^EXE$IPID_TO_PCB ;Get PCB address beql 30$ ;PCB translation failure brb 40$ 30$: movl #SS$_NONEXPR,r0 ret 40$: movl r0,r4 ;set PCB addr in R4 bbc #PCB$V_RES,PCB$L_STS(r4),30$ ;issue NONEXPR for SWAPO movl PCB$L_PHD(r4),r5 ;get PHD bicl rmv_q_prv,PCB$Q_PRIV(r5) ;remove 1-1 bicl rmv_q_prv+4,PCB$Q_PRIV+4(r5) ;remove 1-2 bisl set_q_prv,PCB$Q_PRIV(r5) ;set 1-1 bisl set_q_prv+4,PCB$Q_PRIV+4(r5) ;set 1-2 bicl rmv_q_prv,PHD$Q_PRIVMSK(r5) ;remove 2-1 bicl rmv_q_prv+4,PHD$Q_PRIVMSK+4(r5) ;remove 2-2 bisl set_q_prv,PHD$Q_PRIVMSK(r5) ;set 2-1 bisl set_q_prv+4,PHD$Q_PRIVMSK+4(r5) ;set 2-2 movzbl #SS$_NORMAL,r0 ret rmtsetdflt: ; 10: COND rmt set dflt: confirm, $CMKRNL/SCH$QAST, exit bsbw confirm .IF NDF,NOCMKRNL $CMKRNL_S - routin = 20$ .IFF movl #SS$_KERNELINV,r0 ;ABORT operation .ENDC blbs r0,10$ movl r0,status 10$: bsbw lstprv ;Perform list operation brw ekerch ;leave 20$: .word ^m movaw exception,(FP) ;set exception handler movl #POK_K_LENGTH,r1 ;Allocate pool jsb g^EXE$ALONONPAGED ;r0=retcod,r1=len,r2=addr blbcw r0,100$ ;mem is deall after AST by VMS pushr #^m ;Copy code (save regs) movc3 #code_length,code_begin,POK_B_CODE(r2) ;move! popr #^m ;restore squashed registers movab POK_B_ACB(r2),r6 ;Complete ACB address movl r1,ACB$W_SIZE(r6) ;size of whole block movb #DYN$C_ACB,ACB$B_TYPE(r6) ;this is an ACB movb #PSL$C_KERNEL,ACB$B_RMOD(r6) ;KERNEL mode AST bisb #ACB$M_NODELETE,ACB$B_RMOD(r6) ;Don't delete ACB movaw POK_B_CODE(r2),ACB$L_AST(r6) ;execution address movl r2,ACB$L_ASTPRM(r6) ;all this works 'cuz non-paged movq set_q_prv,POK_Q_ENBMSK(r2) ;privs to set movq rmv_q_prv,POK_Q_DISMSK(r2) ;privs to remove clrl POK_L_STATUS(r2) ;start w/zero status clrb POK_B_INTLK(r2) ;start w/zero compl intlk movl pid,r0 bneq 30$ movl PCB$L_EPID(r4),r0 ;Get our PID if passed 0 30$: jsb g^EXE$EPID_TO_IPID ;Change it up for ACB beql 80$ ;No such process (zaps NULL too) cmpl r0,g^SCH$GL_SWPPID ;See if swapper beql 80$ ;Ditch this too movl r0,ACB$L_PID(r6) ;Save IPID movl #PRI$_TICOM,r2 ;priority increment movl r6,r5 ;Ast address jsb g^SCH$QAST ;Queue the AST... blbc r0,90$ ;Block is NOT auto-deleted 40$: bbcci #0,POK_B_INTLK(r6),40$ ;SPIN INTERLOCK movl POK_L_STATUS(r6),status ;recover remote status brb 90$ ;Now... delete ACB 80$: movzwl #SS$_NONEXPR,r0 90$: movl r0,r3 ;save return code movl r6,r0 ;address to deallocate jsb g^EXE$DEANONPAGED ;free up unused memory movl r3,r0 ;restore return code 100$: ret ekerch: movzbl #SS$_NORMAL,r0 ;force OK return ret lstprv: ;list operation bbs #SW_V_LIST,flags,10$ rsb ;no list operation requested 10$: movl maskid,r2 movl prvdsc[r2],r3 ;get description of priv type ; bbs #SW_V_FULL,flags,20$ ;see if full logging ; brw 30$ ;Skip priv type annunciation 20$: PRINTF ,r3 ;Print privilege type 30$: bbs #0,jpiflg,35$ ;Privileges already read $GETJPIW_S - itmlst = jpiprv,- pidadr = pid,- iosb = iosb blbc r0,40$ ;test normal return code movzwl iosb,r0 blbc r0,40$ ;test IOSB incl jpiflg ;indicate JPI done 35$: movaq allprv[r2],r0 bsbw prtprv ;Print requested privilege mask rsb 40$: movl r0,status brw ekerch ;unnatural exit dnyprv: ;list denied privileges operation 10$: movl maskid,r2 movl prvdsc[r2],r3 ;get description of priv type bbs #0,jpiflg,20$ ;Privileges already read $GETJPIW_S - itmlst = jpiprv,- pidadr = pid,- iosb = iosb blbc r0,40$ ;test normal return code movzwl iosb,r0 blbc r0,40$ ;test IOSB incl jpiflg ;indicate JPI done 20$: movaq allprv[r2],r0 bicl (r0),set_q_prv bicl 4(r0),set_q_prv+4 ;calculate denied mask bisl3 (r0),4(r0),r0 ;see if any were denied beql 30$ PRINTF movaq set_q_prv,r0 bsbw prtprv ;Print requested privilege mask 30$: rsb 40$: movl r0,status brw ekerch ;unnatural exit setimgprv: ;set image privs to GROUP/WORLD/SETPRV/CMKRNL if possible (no errors) pushr #^m clrq -(SP) movaq (SP),r2 bbss #PRV$V_CMKRNL,(r2),10$ 10$: bbss #PRV$V_WORLD,(r2),15$ 15$: bbss #PRV$V_GROUP,(r2),20$ 20$: bbss #PRV$V_SETPRV,(r2),30$ 30$: clrq -(SP) pushl r2 movzbl #1,-(SP) calls #4,g^SYS$SETPRV cmpl r0,#SS$_NORMAL beql 40$ cmpl r0,#SS$_NOTALLPRIV beql 50$ movl r0,status brw ekerch ;unnatural exit 40$: moval 8(SP),SP ;reset stack popr #^m rsb 50$: bbc #SW_V_EXEC,flags,40$ ;don't do this if /EXEC is not set clrq -(SP) pushl r2 movzbl #1,-(SP) calls #4,b^60$ brb 40$ 60$: .word 0 $CMEXEC_S - routin = @#SYS$SETPRV,- arglst = (AP) ret confirm:pushr #^m .IF NDF,NOCMKRNL movq faob1+8,faob1 ;reset descriplen PRINTF ,- usefao=yes PRINTF <Operating system integrity could be compromised> PRINTF ,- usefao=yes INQUIRE faob1,? > cmpw #3,faob1 bneq 10$ pushaq faob1 pushaq faob1 calls #2,g^STR$UPCASE blbc r0,10$ cmpc3 #3,@faob1+4,@yesdsc+4 bneq 10$ popr #^m rsb 10$: movl #SS$_ABORT,status brw ekerch ;unnatural exit .IFF PRINTF ,- usefao=yes movl #SS$_KERNELINV,status brw ekerch ;unnatural exit .ENDC prtprv: ;print privileges set in quad (r0) bbs #SW_V_FULL,flags,1$ brw 50$ 1$: pushr #^m movl r0,r2 clrl r3 10$: bbc r3,(r2),20$ bsbb 30$ ;print name/description 20$: aoblss #TBLLEN,r3,10$ popr #^m rsb 30$: movq dsctab[r3],r4 bneq 40$ rsb 40$: PRINTF ,r4,r5 rsb 50$: ;print privilege names only pushr #^m movl r0,r2 clrq r6 ;clear print flags/last print bit number clrl r3 60$: bbc r3,(r2),65$ movq dsctab[r3],r4 beql 65$ ;ignore non-defined privileges movl r3,r6 ;save last set bit 65$: aoblss #TBLLEN,r3,60$ clrl r3 70$: bbc r3,(r2),75$ bsbb 80$ ;print name/description 75$: aoblss #TBLLEN,r3,70$ popr #^m rsb 80$: movq dsctab[r3],r4 bneq 90$ rsb 90$: tstl r7 bneq 110$ ;printmor to same buffer movq faob1+8,faob1 ;save description of buffer cmpl r6,r3 ;is this the last bit??? beql 100$ ;yes... print nocomma SPRINTF faob1,,r4 ;print initial privilege name bisl #1,r7 ;indicate print pending rsb 100$: PRINTF ,r4 ;print initial & last privilege name rsb 110$: movzwl (r4),r0 movzwl faob1,r1 addl r1,r0 ;will cur+nxt >79?? cmpl r6,r3 ;is this the last bit??? beql 120$ ;yes... print nocomma incl r0 120$: cmpl #79,r0 ;see if it'll fit (plus comma if reqd) bgequ 130$ PRINTF ,#faob1 ;dump current buffer clrl r7 ;no print pending brw 90$ ;restart print operation again 130$: cmpl r6,r3 ;is this the last bit??? beql 140$ ;yes... print nocomma movq faob2+8,faob2 ;descriptor of all string SPRINTF faob2,,#faob1,r4 pushr #^m movc3 faob2,@faob2+4,@faob1+4 popr #^m movw faob2,faob1 rsb 140$: PRINTF ,#faob1,r4 rsb prtblk: ;print the contents of TPA block for testing cmpl r0,#LIB$_SYNTAXERR beql 10$ rsb 10$: pushl r0 moval argblk,r2 movq prvnam,-(SP) subl3 4(SP),TPA$L_STRINGPTR(r2),(SP) movaq (SP),r3 addl3 #1,TPA$L_STRINGPTR(r2),-(SP) subl3 #1,TPA$L_STRINGCNT(r2),-(SP) movaq (SP),r4 bbss #TPA$V_AMBIG,TPA$L_OPTIONS(r2),ambig PRINTF brb pstr ambig: PRINTF pstr: PRINTF ,(r3),4(r3),#1,TPA$L_STRINGPTR(r2),(r4),4(r4) moval 16(SP),SP bisl3 #STS$M_INHIB_MSG,(SP)+,r0 rsb .entry prv,^m $GETJPI_S - itmlst = jpilst blbcw r0,barf movl mypid,r0 jsb @#EXE$EPID_TO_IPID movl r0,myipid ;save IPID for duplication detection clrq set_q_prv clrq rmv_q_prv clrl setresflg clrl flags clrl pid clrl jpiflg pushaw prvnam clrl -(SP) ;no prompt... don't prompt user pushaq prvnam calls #3,G^LIB$GET_FOREIGN ;get privilege name cmpl #RMS$_EOF,r0 bneq 10$ movl #SS$_NORMAL,r0 brw barf 10$: blbcw r0,barf pushaq prvnam pushaq prvnam calls #2,G^STR$UPCASE ;force to uppercase blbcw r0,barf moval argblk,r2 movl #TPA$K_COUNT0,TPA$L_COUNT(r2) movzwl prvnam,TPA$L_STRINGCNT(r2) movab @prvnam+4,TPA$L_STRINGPTR(r2) movl #TPA$M_ABBREV,TPA$L_OPTIONS(r2) pushab kytbl pushab sttbl pushal argblk calls #3,G^LIB$TPARSE blbs r0,eggzit bsbw prtblk eggzit: movzbl #SS$_NORMAL,r0 tstl status beql barf movl status,r0 barf: ret .end prv