.TITLE PrcArmor ; Set or unset nodelete etc. bits for a process .IDENT /1.0/ vms$v5=1 ;++ ; ; Title: ; Prcarmor ; ; Action: ; This program will set or clear the nodelete etc. bits for a ; process. Clearing will clear forcex pending etc. too. ; ; Calling sequence: ; ; $ armor := $mydev:[mydir]prcarmor ; $ armor device/PID:nnnnnnnn[/set][/clear] ; ; Environment: ; CMKRNL privilege required, I/O data base is locked, program ; executed at elevated IPL. ; ; Author: ; Glenn Everhart. Uses some code from ZDEC.MAR by Mark Oakley. ;-- .SBTTL Symbols, Macros, Data .LIBRARY /SYS$LIBRARY:LIB.MLB/ $TPADEF ; Symbols for LIB$TPARSE. $SSDEF ; Symbols for return status. $UCBDEF ; Symbols for device ucb. $STSDEF ; Symbols for returned status. $DVIDEF ; Symbols for $GETDVI service. $DCDEF ; Symbols for device type. $DEVDEF ; SYM. FOR SDI TYPE DEVICE. $pcbdef ; pcb symbols .PSECT CDEV_DATA,RD,WRT,NOEXE,LONG,SHR,PIC wrk: .long 0 ; scratch setds: .ascid /SET/ clrds: .ascid /CLEAR/ PIDDS: .ASCID /PID/ ; /PID switch PIDVL: .word 32 ; length of buffer .byte dsc$k_dtype_t ;text type .byte 1 ;fixed static .address pidtx pidtx: .blkl 8 ;text area for /pid:nnnnnnnn "nnnnnnnn" value pidwk: .long 0 ;work storage newpid: .long 0 ;pid to move device to setfg: .long 0 clrfg: .long 0 P1DSC: .ascid /Device/ ; in .cld have a line ; parameter p1,prompt="Device:",value(required,type=$device),label=Device DEV_BUF: ; Buffer to hold device name. .BLKB 40 DEV_BUF_SIZ = . - DEV_BUF DEV_BUF_DESC: ; Descriptor pointing to device name. .LONG DEV_BUF_SIZ .ADDRESS DEV_BUF PID: ; Owner of device (if any). .BLKL 1 K_ARG: ; Argument list for kernel-mode routine. .LONG 2 ; 2 args .ADDRESS DEV_BUF_DESC ; Pass descriptor for device name. .address newpid ; PID to "give" device to. cmd_len = 80 cmd_desc: .long cmd_len .address cmd_buf cmd_buf: .blkl cmd_len cld_len = 90 cld_desc: .long cld_len .address cld_buf cld_buf: .blkl cld_len onfg: .long 0 offfg: .long 0 CMD_NAME: .ASCID "PRCARMOR" ; Note: pid field must be nonzero or this is a no-op. ; UCB$L_PID is set... .macro check ?l blbs r0,l $exit_s r0 l: .endm check .SBTTL Main program .PSECT CDEV_CODE,RD,NOWRT,EXE,LONG,SHR,PIC .ENTRY CDEV,^M ; Get the args. ; ; Get the command line ; pushl #0 ; flags pushal cmd_desc ; resultant-length pushl #0 ; prompt pushal cmd_desc ; resultant-string calls #4,g^lib$get_foreign check ; ; Append the newly gotten string to the command name ; pushal cmd_desc pushal cmd_name pushal cld_desc calls #3,g^str$concat check ; ; Get DCL to parse it for us ; pushl #0 ; prompt_string pushal g^lib$get_input ; prompt_routine pushl #0 ; param_routine pushal prcarmor_cld ; table pushal cld_desc ; command_string calls #5,g^cli$dcl_parse check clrl clrfg clrl setfg incl clrfg ;default clear ; see if /set or /clear given. Default is clear if neither. pushab setds calls #1,g^cli$present cmpl r0,#cli$_present bneq 3$ incl setfg clrl clrfg 3$: pushab clrds calls #1,g^cli$present cmpl r0,#cli$_present bneq 4$ incl clrfg clrl setfg 4$: clrl newpid pushab wrk ;return len pushab dev_buf_desc ;descriptor to return pushab p1dsc ;get P1 (device) calls #3,g^cli$get_value ;get it blbs r0,10$ ; (we need no device actually) ;; brw exit 10$: clrl newpid pushab pidds ; /pid:nnnn present? calls #1,g^cli$present cmpl r0,#cli$_present beql 20$ brw 30$ 20$: ; saw /pid=nnnnn ; now get value and convert to binary in newpid from hex pushab wrk ;length of return string here pushab pidvl ;string to put chars into pushab pidds ;want /pid:nnnn value calls #3,g^cli$get_value ;get "nnnnnnnn" string blbs r0,40$ brw 30$ 40$: ;now have string. Convert hex to bin now. movl wrk,pidvl ;set correct length now pushl #1 ;flags...ignore blanks pushl #4 ;4 byte result pushab newpid ;store result here pushab pidvl ;get number from this string calls #4,g^ots$cvt_tz_l ;hex ascii to long ; 30$: $CMKRNL_S - ; Enter k-mode to claim device for pid ROUTIN=ArmSet,- ARGLST=K_ARG BLBS R0,80$ BRW EXIT 80$: ; leave ret code in r0 EXIT: RET .SBTTL ArmSet Routine ;++ ; ; Functional Description: ; Clear nodelete bit or set it. ; ; Calling Sequence: ; $CMKRNL_S ROUTIN=ArmSet,ARGLST=K_ARG ; ; where K_ARG is an argument list. This list contains ; the number of arguments passes (always 2), followed ; by the address of a descriptor pointing to the name ; of a device and the address of the new PID from the ; user. ; ; Formal Parameters: ; Descriptor for name of a device. ; ; Implicit Inputs: ; I/O database. ; ; Implicit Outputs: ; Device error count is set to ArmSet. ; ; Completion Status: ; Returned in R0. ; ; Side Effects: ; I/O database is locked (routine runs in kernel mode at elevated ; IPL). ; ;-- .ENTRY ArmSet,^M MOVL G^CTL$GL_PCB,R4 ;; Our PCB address is input to SCH ;; routines. JSB G^SCH$IOLOCKW ;; Lock the I/O database. movl @8(ap),r10 ;;; get newpid movl g^ctl$gl_pcb,r8 ;our pcb movl r10,r6 beql 20$ ; Zero means it's us. Use PCB in R8 ; ; Scan through system PCBs checking their PID fields for our target one ; Put PCB address in R8 and use it to get PID. ; movzwl sch$gl_maxpix,r7 ; Maximum process index lock lockname=sched ; Raise IPL, acquire MUTEX 10$: movl @sch$gl_pcbvec[r7],r8 ; Get a PCB address cmpl pcb$l_epid(r8),r6 ; Is this the one? beql 20$ ; Sure, jump out of loop sobgtr r7,10$ ; Nope, try another unlock lockname=sched ; Failed... lower IPL, release MUTEX movl #ss$_nonexpr,r0 ; Not on this node... $exit_s r0 ; Error out 20$: ; r8 is the pcb ; set/clear things by main force. unlock lockname=sched tstl pcb$l_sts(r8) ;since we're back at ipl2, see if we ;can fault this in if need be. tstl clrfg ;clearing? bneq 100$ ; if neq yes tstl setfg ;setting? beql 999$ ;if eql doing nothing apparently ; setting bisl #pcb$m_nodelet,pcb$l_sts(r8) ;set nodelete bit movl #1,r0 brw armset_exit 100$: bicl #,pcb$l_sts(r8) ;clr nodelete bit MOVL #SS$_NORMAL,R0 brb armset_exit 999$: movl #ss$_badparam,r0 ArmSet_EXIT: PUSHL R0 ;;; Remember status. JSB G^SCH$IOUNLOCK ;;; Unlock I/O database (drop IPL). POPL R0 RET .END CDEV