n ~ KERNEL.BCK KERNEL.BCK#BACKUP [.KERNEL]*.* KERNEL.BCK/SAVE T_WADE  pfIV5.5 _KIRK::  _KIRK$DKA0: V5.5 ~  %*[TWADE.DECUSTAPE.KERNEL]ACCOUNT.MAR;3+,' ./ 4M-& 0123KPWO56h7Ҏ74}I89G HJ G; Program to change your account dynamically. We must first force anM; accounting record, then change the account field in the JIB and in P1 CTL9; region. We must also zero all the accounting fields.;"; Tom Wade ;6; Program runs in Kernel mode (CMKRNL privs required).D; This program is provided as is. No responsibility is accepted for.; any mishaps resulting from use of this code.;.; Calling format: SET_ACCOUNT (account_name);8; account_name: account string (passed by descriptor).;; Modifications:B; 1.1 Clear field PHD$L_TIMREF, which contains CPU time since last@; AWSA. Otherwise AWSA will not take effect until the CPU time'; again reaches that value. Thanks to*; Carl Karcher  .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" .Ident "V1.1" $PCBDEF $JIBDEF $PHDDEF)Account_desc: .Long 0 ; descriptor for"Account: .Long 0 ; new account.0 .Entry SET_ACCOUNT ^M 0 Movq @4(AP), account_desc ; get account name.. Cmpl account_desc, - ; is length too big ? #Jib$S_Account Bleq do_it 8 Movl #Jib$S_Account, account_desc ; yes - truncate it.Do_it: $CMKRNL_S - ; Engage ! routin = RESET_ACCOUNT 10$: Ret2 .Entry RESET_ACCOUNT ^M 8 Movl #SS$_Normal, G^Ctl$GL_Finalsts ; set status to OK Clrl R5 ; special flag off/ Jsb G^Exe$Prcpurmsg ; write accounting rec.+ Clrl G^Ctl$GL_Volumes ; zero mount count) Clrl G^Ctl$GL_Wspeak ; work set peak.1 Clrl G^Ctl$GL_Virtpeak ; virtual address peak.0 Movq G^Exe$GQ_Systime, - ; reset elapsed time G^Ctl$GQ_Login, Movl Pcb$L_Phd(R4), R6 ; get PHD address., Movl Pcb$L_Jib(R4), R7 ; get JIB address.) Clrl Phd$L_Cputim(R6) ; clear CPU time. Clrl Phd$L_Pageflts(R6) ; clear page faults* Clrl Phd$L_Pgfltio(R6) ; page fault I/O. Clrl Phd$L_Biocnt(R6) ; Buffered I/O count., Clrl Phd$L_Diocnt(R6) ; Direct I/O count.- Clrl Phd$L_Imgcnt(R6) ; image activations./ Clrl Phd$L_Timref(R6) ; AWSA time reference.= Movc5 account_desc, @account, #^A" ",-; move space extended6 #Jib$S_Account, G^Ctl$T_Account ; account name into6 Movc5 account_desc, @account, #^A" ",-; CTL and JIB.$ #Jib$S_Account, Jib$T_Account(R7)# Movl #SS$_Normal, R0 ; Finished. Ret ; beam me up Scotty. .End/*[TWADE.DECUSTAPE.KERNEL]GET-COMMAND-PROC.MAR;11+,' ./ 4K-& 0123KPWO56;I7D }I89G HJK; Program to get the name of the current command procedure. ; Tom Wade T.Wade@vms.eurokom.ie;G; Calling sequence ret_code := GET_COMMAND_FILE_NAME (file, length);F; file: String to receive name of current command file (descriptor).F; length: Address of longword to receive length of file (reference).;0; e.g. Integer *4 GET_COMMAND_FILE, length*; Character *100 file (for FORTRAN)/; ; 'file' will be blank padded.;:; Program requires CMEXEC privileges to get at the data.! .Title GET_CURRENT_COMMAND_PROC $FABDEF $RABDEF0 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH- .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH 5Arg_descriptor: .Long 0 ; descriptor for input arg.-Address: .Long 0 ; pointer to string start.. .Entry GET_COMMAND_FILE_NAME ^M , Movq @4(AP), arg_descriptor ; get filename8 Movzwl arg_descriptor, R8 ; get length into longword.) $CMEXEC_S - ; Nip upstairs and get the" routin=GET_INFO ; information.. Movl R7, @8(AP) ; return length in 2nd arg.< Movc5 R7, (R6), #^A" ", R8,- ; return string blank filled @address ; in 1st arg.* Movl #SS$_Normal, R0 ; indicate success Ret/Get_Info: .Word 0 ; don't save any registers.5 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI data.+ Movl Ppd$L_Prc(R6), R6 ; get DCL stuff.2 Movl Prc_L_Inprab(R6),R6 ; get input RAB address- Movl Rab$L_Fab(R6), R6 ; get FAB from RAB2 Movl Fab$L_Nam(R6), R6 ; get NAM block from FAB5 Movzbl Nam$B_Rsl(R6), R7 ; get length of filename5 Movl Nam$L_Rsa(R6), R6 ; get address of file name. Ret ; return the info.. .End  +*[TWADE.DECUSTAPE.KERNEL]GET-JOB-TABLE.MAR;4+,' . / 4O -& 0123KPWO 56[WJӔ7D}I89G HJN;*****************************************************************************; .Title GET_JOB_TABLE_NAME5; Get the name of the Job Table for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;=; This routine works under VMS 5.4, and should work for 5.x; invocation is;+; status := GET_JOB_TABLE (pid, table_name);; Parameters:;; pid: Process ID of target process. Passed by reference.?; table_name: Address of character string into which is written; the job table name.0; Returns: SS$_NORMAL or error code from $NAMPID;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.0" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocksO;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------$Space = ^A" " ; space character.(Arg_string: ; user specified string.String_length: .Long 0String_ptr: .Long 0/Table_name: .Ascii "LNM$JOB_" ; Name of Table..Jib_Text: .Blkb 8 ; Hex form of JIB address.2JT_Length = .-table_name ; length of table name.0Hex_desc: .Long 8 ; descriptor for Hex form of# .Address jib_text ; JIB address.:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------* .Entry GET_JOB_TABLE ^M + Movl @4(AP), epid ; get PID from caller.3 Movq @8(AP), arg_string ; get string from caller.) $LKWSET_S - ; batten down the hatches2 inadr = lock_range  Blbc R0, return $CMKRNL_S - ; Warp drive on. routin = Get_Jib_Address, - arglst = pid_args Blbc R0, return / Pushaq hex_desc ; convert JIB address to hex Pushal jib_address ; form Calls #2, G^Ots$Cvt_L_Tz Blbc R0, return> Movc5 #jt_length, table_name,-; copy the table name into the9 #space, string_length,- ; caller's string padding with @string_ptr ; blanks.* Movl #SS$_Normal, R0 ; indicate success. Return: RetO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 02Jib_address: .Long 0 ; where to put JIB address.O;------------------------------------------------------------------------------; Kernel Mode Code.?; Convert EPID to IPID, and find the JIB address in the target; PCB.O;------------------------------------------------------------------------------, .Entry GET_JIB_ADDRESS ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.$ ; (target PCB address returned ; in R4).- Movl Pcb$L_Jib(R4), - ; get the JIB address jib_address6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty. .End'*[TWADE.DECUSTAPE.KERNEL]PROC-NAME.CLD;2+,' ./ 47-& 0123KPWO56 N77T<5}I89G HJ Define Verb PROCNAME Image SYS$DISK:[]SET-PROCNAME, Parameter P1, Label=NAME, Value (required)7 Qualifier ID, Value (required), Default, nonnegatable,*[TWADE.DECUSTAPE.KERNEL]SET-DCL-PROMPT.MAR;4+,' ./ 4K-& 0123KPWO56JnjҔ7|}I89G HJ .Title SET_MY_PROMPT- .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH0 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH;K; Set our DCL prompt to that specified. The program running this routine/; should be installed with CMEXEC privileges.;; Calling Sequence:; SET_DCL_PROMPT (prompt);8; Prompt: String for DCL prompt passed by descriptor.; Returns: Sucess code. Prompt_desc:+Length: .Long 0 ; DCL Prompt descriptor.$Prompt: .Long 0 ; string pointer. .Entry SET_DCL_PROMPT ^M <>/ Movq @4(AP), prompt_desc ; get user's prompt.( Clrw length+2 ; clear desc type bits.% Cmpl length, #32 ; is it too long. Blss 10$ ; no - carry on( Movw #32, length ; yes - truncate it..10$: $CMEXEC_S - ; do writing in EXEC mode. routin = do_set_promptExit: Ret ; return to DCL .Entry DO_SET_PROMPT ^M 6 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI stuff.5 Movl Ppd$L_Prc(R6), R6 ; get address of PRC block.2 Addb3 #3, length, - ; load length field (add 3- Prc_B_Promptlen(R6) ; for prompt control).4 Movc3 length, @prompt, - ; move the prompt string. Prc_G_Prompt(R6)+ Movl #SS$_Normal, R0 ; indicate success. Ret .End%*[TWADE.DECUSTAPE.KERNEL]SET-EFN.MAR;4+,'./ 4O:-& 0123KPWO56@wo7)}I89G HJ O;****************************************************************************** .Title SET_FLAGN; Program to set a Local Event Flag for another process. Calling sequence:;'; ret_code := SET_FLAG (pid, efn);J; Pid: Address of Longword containing Process ID (EPID) of target.D; Efn: Address of Longword containing the event flag to set.;K; Returns: SS$_Normal for success, SS$_ILLEFC for bad event flag numberD; or other error indicating non-existence or remote nature of; target process.;$; Tom Wade ;N; WARNING: Program runs in kernel mode at elevated IPL. While it has been:; tested at VMS 5.4-2, please use at your own risk. .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" $PCBDEF<Lock_vector: .Address lock_start ; area of WS to lock down. .Address lock_end'Lock_start: ; start of WS lock area#Efn: .Long 0 ; event flag numberPid: .Long 0 ; target PID0Args: .Long 2 ; arg block for Kernel routine./ .Address pid ; address of target pid (ext).$ .Long 0 ; process name (unused). .Entry SET_EFN ^M <>% Movl @4(AP), pid ; get target PID., Movl @8(AP), efn ; get target event flag.' Cmpl efn, #31 ; check for valid EFN. Bgtr bad_efn$ Cmpl efn, #0 ; negative EFNs too.' Bgeq batten_down ; OK - let's do it.0Bad_efn: Movl #SS$_Illefc, R0 ; indicate bad EFN Error: Ret Batten_down:* $LKWSET_S - ; batten down the hatches. inadr = lock_vector Blbc R0, error' $CMKRNL_S - ; Jump to System Space. Routin = Set_Flag, - arglst = args Ret ; and finished.Set_Flag: .Word ^M 1 Jsb G^Exe$Nampid ; get internal PID (and go to ; warp factor 8." Blbs R0, ok ; did we get it OK?$ Movl R0, R6 ;no - save error code' Setipl #0 ; and return to sublight. Movl R0, R6 ; return error. Ret,Ok: Movl efn, R3 ; R3 contains flag number ; R1 already contains IPID Clrl R2 ; no priority boost.# Jsb G^Sch$Postef ; set his flag." Movl R0, R6 ; save status code.8 Unlock lockname=SCHED, - ; release spinlock and return$ newipl = #0 ; to sublight speed. Lock_End:$ Movl R6, R0 ; return status code." Ret ; and back to user space. .End**[TWADE.DECUSTAPE.KERNEL]SET-PROCNAME.MAR;1+,' . / 4O "-& 0123KPWO 56`g|67,}I89G HJN;*****************************************************************************; .Title SET_PROC_NAME-; Set the Process Name for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;=; This program works under VMS 5.4, and should work for 5.x; Command invocation is;&; $ PROCNAME "process-name" /id=;K; You may need to SET COMMAND PROC-NAME.CLD if the command is not in your"; DCLTABLES (which is unlikely).;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.0" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocksO;------------------------------------------------------------------------------ ; Macros.O;------------------------------------------------------------------------------) .Macro CHECK ?label ; check the status# Blbs R0, label ; and exit if not $EXIT_S R0 ; ok. Label: .Endm CHECK O;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------7Proc_prompt: .Ascid "NAME" ; prompt for the proc name/Pid_Prompt: .Ascid "ID" ; prompt for the PID.%Input_desc: .Long 15 ; user's input .Address proc_name-Pid_desc: .Long 8 ; user's PID in text form .Address pid_textPid_Text: .Blkb 8:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------ .Entry Start ^M <>! Pushal length ; input via CLD Pushaq input_desc Pushaq proc_prompt Calls #3, G^Cli$Get_Value Check) Pushal pid_desc ; get the target EPID. Pushaq pid_desc Pushaq pid_prompt Calls #3, G^Cli$Get_Value Check* Pushal epid ; Convert from hexadecimal( Pushaq pid_desc ; string to longword. Calls #2, G^Ots$Cvt_TZ_L Check) $LKWSET_S - ; batten down the hatches inadr = lock_range Check $CMKRNL_S - ; Warp drive on. routin = set_proc_name, - arglst = pid_args Ret ; return to DCLO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 0,Proc_name: .Blkb 15 ; actual process name.,Length: .Long 0 ; length of process name.O;------------------------------------------------------------------------------; Kernel Mode Code.;; Convert EPID to IPID, and poke the process name into the; target PCB.O;------------------------------------------------------------------------------* .Entry SET_PROC_NAME ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.$ ; (target PCB address returned ; in R4)., Movb length, - ; poke length of proc name Pcb$T_Lname(R4) ; into PCB8 Movc3 length, proc_name,- ; poke process name into PCB Pcb$T_Lname+1(R4)6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty. .End Start(*[TWADE.DECUSTAPE.KERNEL]SET-PROMPT.CLD;2+, './ 47-& 0123KPWO56`V747}I89G HJ Define Verb PROMPT Image SYS$DISK:[]SET-PROMPT. Parameter P1, Label=PROMPT, Value (required)7 Qualifier ID, Value (required), Default, nonnegatable(*[TWADE.DECUSTAPE.KERNEL]SET-PROMPT.MAR;9+,' . / 4O -& 0123KPWO 56 cߖ7F.}I89G HJN;***************************************************************************** .Title SET_PROMPT+; Set the DCL prompt for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;D; This program works under VMS 5.4, and should work for 5.2 & 5.3.; Command invocation is;$; $ PROMPT "prompt-string" /id=;L; You may need to SET COMMAND SET-PROMPT.CLD if the command is not in your"; DCLTABLES (which is unlikely).;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.1" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH1 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocks# $DYNDEF ; Dynamic memory types( $IPLDEF ; Interrupt Priority Levels" $ACBDEF ; AST Control Blocks.& $PRIDEF ; Priority boost classes. $SPLDEF ; SpinlocksO;------------------------------------------------------------------------------ ; Macros.O;------------------------------------------------------------------------------) .Macro CHECK ?label ; check the status# Blbs R0, label ; and exit if not $EXIT_S R0 ; ok. Label: .Endm CHECK O;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------8Prompt_prompt: .Ascid "PROMPT" ; prompt for the prompt./Pid_Prompt: .Ascid "ID" ; prompt for the PID.%Input_desc: .Long 32 ; user's input .Address prompt-Pid_desc: .Long 8 ; user's PID in text form .Address pid_textPid_Text: .Blkb 8:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------ .Entry Start ^M <>! Pushal length ; input via CLD Pushaq input_desc Pushaq prompt_prompt Calls #3, G^Cli$Get_Value Check) Pushal pid_desc ; get the target EPID. Pushaq pid_desc Pushaq pid_prompt Calls #3, G^Cli$Get_Value Check* Pushal epid ; Convert from hexadecimal( Pushaq pid_desc ; string to longword. Calls #2, G^Ots$Cvt_TZ_L Check) $LKWSET_S - ; batten down the hatches inadr = lock_range Check $CMKRNL_S - ; Warp drive on. routin = set_prompt, - arglst = pid_args Ret ; return to DCLO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended PidIpid: .Long 0 ; Internal Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 0O;------------------------------------------------------------------------------; Kernel Mode Code.9; Convert EPID to IPID, build an ACB and sent him a nice; Kernel Mode AST.O;------------------------------------------------------------------------------+ .Entry SET_PROMPT ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.6 Bbc #Pcb$V_Inter, - ; check that the target process/ Pcb$L_Sts(R4), not_inter; is interactive.% Movl R1, ipid ; save internal PID.5 Movl #Prompt_Ast_Size, - ; allocate a chunk of pool' R1 ; big enough for the ACB + code5 Jsb G^Exe$Alononpaged ; R2 := address of pool area.4 Blbc R0, sub_light ; error - drop IPL and spinlock; Pushr #^M ; save regs from MOVC35 Movc3 #Prompt_Ast_size, - ; copy the code into pool Prompt_Ast, (R2)8 Popr #^M ; restore registers., Movw R1, Acb$W_Size(R2) ; load size of ACB/ Movb #Dyn$C_Acb, - ; load type of pool area. Acb$B_Type(R2)* Moval (R2),-0 Acb$L_Kast(R2) ; load address of Kernel AST.1 Clrb Acb$B_Rmod(R2) ; clear request mode bits.5 Bisb #Acb$M_Kast, - ; indicate special Kernel Mode Acb$B_Rmod(R2) ; AST.- Movl ipid, Acb$L_pid(R2) ; load target PID.* Movl R2, R5 ; SCH$QAST wants ACB in R5.4 Movl #Pri$_Ticom, R2 ; a helpful kick in the rear! Jsb G^Sch$Qast ; fire the AST.6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty.BNot_Inter: Unlock lockname=SCHED, - ; don't hit a detached process" newipl=#0 ; or we Bugcheck :-(3 Movl #Lib$_Nocli, R0 ; say something comforting. Brb exit,Sub_light: Setipl #0 ; drop IPL to normal. Brb exitO;------------------------------------------------------------------------------E; The ACB followed by the Kernel AST to be delivered to the victim.O;------------------------------------------------------------------------------ Prompt_Ast:3Acb: .Blkb Acb$K_Length ; allocate space for ACB.&Length: .Long 0 ; Length of prompt.#Prompt: .Blkb 32 ; Prompt text. 'Prompt_Ast_Code: ; code begins here.& Pushl R6 ; save temporary register" Pushl R5 ; save address of ACB6 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI stuff.5 Movl Ppd$L_Prc(R6), R6 ; get address of PRC block.3 Addb3 #3, W^length, - ; load length field (add 3- Prc_B_Promptlen(R6) ; for prompt control).7 Movc3 W^length, W^prompt, - ; move the prompt string. Prc_G_Prompt(R6)' Popl R0 ; restore ACB address to R0 Popl R6 ; restore R6.( Jmp G^Exe$Deanonpaged ; into oblivion.0 prompt_ast_size = .-prompt_ast ; size of pool. .End Start%*[TWADE.DECUSTAPE.KERNEL]SET-UIC.MAR;2+,'./ 4O-& 0123KPWO56"7c7=Y1}I89G HJO;****************************************************************************** .Title SET_PROCESS_UIC?; Program to set the UIC for this process. Calling sequence:;!; ret_code := SET_UIC (uic);6; Uic: Address of longword containing the UIC.;&; Returns: SS$_Normal for success.D; or other error indicating non-existence or remote nature of;$; Tom Wade ;>; WARNING: Program runs in kernel mode. While it has beenB; tested at VMS 5.4-3 & 5.5-1, please use at your own risk. .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" $PCBDEF .Entry SET_UIC ^M ' Movl @4(AP), R6 ; get the UIC value.. $CMKRNL_S - ; enter Kernel mode to set it. routin = SET_THE_UIC$ Ret ; give DCL the code we get. .Entry SET_THE_UIC ^M <>, Movl R6, Pcb$L_Uic(R4) ; load the new UIC.) Movl #SS$_Normal, R0 ; indicate success Ret ; and out of here. .EndLUI~ KERNEL.BCK KERNEL.BCK#BACKUP [.KERNEL]*.* KERNEL.BCK/SAVE T_WADE  pfIV5.5 _KIRK::  _KIRK$DKA0: V5.5 ~  %*[TWADE.DECUSTAPE.KERNEL]ACCOUNT.MAR;3+,' ./ 4M-& 0123KPWO56h7Ҏ74}I89G HJ G; Program to change your account dynamically. We must first force anM; accounting record, then change the account field in the JIB and in P1 CTL9; region. We must also zero all the accounting fields.;"; Tom Wade ;6; Program runs in Kernel mode (CMKRNL privs required).D; This program is provided as is. No responsibility is accepted for.; any mishaps resulting from use of this code.;.; Calling format: SET_ACCOUNT (account_name);8; account_name: account string (passed by descriptor).;; Modifications:B; 1.1 Clear field PHD$L_TIMREF, which contains CPU time since last@; AWSA. Otherwise AWSA will not take effect until the CPU time'; again reaches that value. Thanks to*; Carl Karcher  .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" .Ident "V1.1" $PCBDEF $JIBDEF $PHDDEF)Account_desc: .Long 0 ; descriptor for"Account: .Long 0 ; new account.0 .Entry SET_ACCOUNT ^M 0 Movq @4(AP), account_desc ; get account name.. Cmpl account_desc, - ; is length too big ? #Jib$S_Account Bleq do_it 8 Movl #Jib$S_Account, account_desc ; yes - truncate it.Do_it: $CMKRNL_S - ; Engage ! routin = RESET_ACCOUNT 10$: Ret2 .Entry RESET_ACCOUNT ^M 8 Movl #SS$_Normal, G^Ctl$GL_Finalsts ; set status to OK Clrl R5 ; special flag off/ Jsb G^Exe$Prcpurmsg ; write accounting rec.+ Clrl G^Ctl$GL_Volumes ; zero mount count) Clrl G^Ctl$GL_Wspeak ; work set peak.1 Clrl G^Ctl$GL_Virtpeak ; virtual address peak.0 Movq G^Exe$GQ_Systime, - ; reset elapsed time G^Ctl$GQ_Login, Movl Pcb$L_Phd(R4), R6 ; get PHD address., Movl Pcb$L_Jib(R4), R7 ; get JIB address.) Clrl Phd$L_Cputim(R6) ; clear CPU time. Clrl Phd$L_Pageflts(R6) ; clear page faults* Clrl Phd$L_Pgfltio(R6) ; page fault I/O. Clrl Phd$L_Biocnt(R6) ; Buffered I/O count., Clrl Phd$L_Diocnt(R6) ; Direct I/O count.- Clrl Phd$L_Imgcnt(R6) ; image activations./ Clrl Phd$L_Timref(R6) ; AWSA time reference.= Movc5 account_desc, @account, #^A" ",-; move space extended6 #Jib$S_Account, G^Ctl$T_Account ; account name into6 Movc5 account_desc, @account, #^A" ",-; CTL and JIB.$ #Jib$S_Account, Jib$T_Account(R7)# Movl #SS$_Normal, R0 ; Finished. Ret ; beam me up Scotty. .End/*[TWADE.DECUSTAPE.KERNEL]GET-COMMAND-PROC.MAR;11+,' ./ 4K-& 0123KPWO56;I7D }I89G HJK; Program to get the name of the current command procedure. ; Tom Wade T.Wade@vms.eurokom.ie;G; Calling sequence ret_code := GET_COMMAND_FILE_NAME (file, length);F; file: String to receive name of current command file (descriptor).F; length: Address of longword to receive length of file (reference).;0; e.g. Integer *4 GET_COMMAND_FILE, length*; Character *100 file (for FORTRAN)/; ; 'file' will be blank padded.;:; Program requires CMEXEC privileges to get at the data.! .Title GET_CURRENT_COMMAND_PROC $FABDEF $RABDEF0 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH- .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH 5Arg_descriptor: .Long 0 ; descriptor for input arg.-Address: .Long 0 ; pointer to string start.. .Entry GET_COMMAND_FILE_NAME ^M , Movq @4(AP), arg_descriptor ; get filename8 Movzwl arg_descriptor, R8 ; get length into longword.) $CMEXEC_S - ; Nip upstairs and get the" routin=GET_INFO ; information.. Movl R7, @8(AP) ; return length in 2nd arg.< Movc5 R7, (R6), #^A" ", R8,- ; return string blank filled @address ; in 1st arg.* Movl #SS$_Normal, R0 ; indicate success Ret/Get_Info: .Word 0 ; don't save any registers.5 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI data.+ Movl Ppd$L_Prc(R6), R6 ; get DCL stuff.2 Movl Prc_L_Inprab(R6),R6 ; get input RAB address- Movl Rab$L_Fab(R6), R6 ; get FAB from RAB2 Movl Fab$L_Nam(R6), R6 ; get NAM block from FAB5 Movzbl Nam$B_Rsl(R6), R7 ; get length of filename5 Movl Nam$L_Rsa(R6), R6 ; get address of file name. Ret ; return the info.. .End  +*[TWADE.DECUSTAPE.KERNEL]GET-JOB-TABLE.MAR;4+,' . / 4O -& 0123KPWO 56[WJӔ7D}I89G HJN;*****************************************************************************; .Title GET_JOB_TABLE_NAME5; Get the name of the Job Table for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;=; This routine works under VMS 5.4, and should work for 5.x; invocation is;+; status := GET_JOB_TABLE (pid, table_name);; Parameters:;; pid: Process ID of target process. Passed by reference.?; table_name: Address of character string into which is written; the job table name.0; Returns: SS$_NORMAL or error code from $NAMPID;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.0" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocksO;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------$Space = ^A" " ; space character.(Arg_string: ; user specified string.String_length: .Long 0String_ptr: .Long 0/Table_name: .Ascii "LNM$JOB_" ; Name of Table..Jib_Text: .Blkb 8 ; Hex form of JIB address.2JT_Length = .-table_name ; length of table name.0Hex_desc: .Long 8 ; descriptor for Hex form of# .Address jib_text ; JIB address.:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------* .Entry GET_JOB_TABLE ^M + Movl @4(AP), epid ; get PID from caller.3 Movq @8(AP), arg_string ; get string from caller.) $LKWSET_S - ; batten down the hatches2 inadr = lock_range  Blbc R0, return $CMKRNL_S - ; Warp drive on. routin = Get_Jib_Address, - arglst = pid_args Blbc R0, return / Pushaq hex_desc ; convert JIB address to hex Pushal jib_address ; form Calls #2, G^Ots$Cvt_L_Tz Blbc R0, return> Movc5 #jt_length, table_name,-; copy the table name into the9 #space, string_length,- ; caller's string padding with @string_ptr ; blanks.* Movl #SS$_Normal, R0 ; indicate success. Return: RetO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 02Jib_address: .Long 0 ; where to put JIB address.O;------------------------------------------------------------------------------; Kernel Mode Code.?; Convert EPID to IPID, and find the JIB address in the target; PCB.O;------------------------------------------------------------------------------, .Entry GET_JIB_ADDRESS ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.$ ; (target PCB address returned ; in R4).- Movl Pcb$L_Jib(R4), - ; get the JIB address jib_address6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty. .End'*[TWADE.DECUSTAPE.KERNEL]PROC-NAME.CLD;2+,' ./ 47-& 0123KPWO56 N77T<5}I89G HJ Define Verb PROCNAME Image SYS$DISK:[]SET-PROCNAME, Parameter P1, Label=NAME, Value (required)7 Qualifier ID, Value (required), Default, nonnegatable,*[TWADE.DECUSTAPE.KERNEL]SET-DCL-PROMPT.MAR;4+,' ./ 4K-& 0123KPWO56JnjҔ7|}I89G HJ .Title SET_MY_PROMPT- .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH0 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH;K; Set our DCL prompt to that specified. The program running this routine/; should be installed with CMEXEC privileges.;; Calling Sequence:; SET_DCL_PROMPT (prompt);8; Prompt: String for DCL prompt passed by descriptor.; Returns: Sucess code. Prompt_desc:+Length: .Long 0 ; DCL Prompt descriptor.$Prompt: .Long 0 ; string pointer. .Entry SET_DCL_PROMPT ^M <>/ Movq @4(AP), prompt_desc ; get user's prompt.( Clrw length+2 ; clear desc type bits.% Cmpl length, #32 ; is it too long. Blss 10$ ; no - carry on( Movw #32, length ; yes - truncate it..10$: $CMEXEC_S - ; do writing in EXEC mode. routin = do_set_promptExit: Ret ; return to DCL .Entry DO_SET_PROMPT ^M 6 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI stuff.5 Movl Ppd$L_Prc(R6), R6 ; get address of PRC block.2 Addb3 #3, length, - ; load length field (add 3- Prc_B_Promptlen(R6) ; for prompt control).4 Movc3 length, @prompt, - ; move the prompt string. Prc_G_Prompt(R6)+ Movl #SS$_Normal, R0 ; indicate success. Ret .End%*[TWADE.DECUSTAPE.KERNEL]SET-EFN.MAR;4+,'./ 4O:-& 0123KPWO56@wo7)}I89G HJ O;****************************************************************************** .Title SET_FLAGN; Program to set a Local Event Flag for another process. Calling sequence:;'; ret_code := SET_FLAG (pid, efn);J; Pid: Address of Longword containing Process ID (EPID) of target.D; Efn: Address of Longword containing the event flag to set.;K; Returns: SS$_Normal for success, SS$_ILLEFC for bad event flag numberD; or other error indicating non-existence or remote nature of; target process.;$; Tom Wade ;N; WARNING: Program runs in kernel mode at elevated IPL. While it has been:; tested at VMS 5.4-2, please use at your own risk. .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" $PCBDEF<Lock_vector: .Address lock_start ; area of WS to lock down. .Address lock_end'Lock_start: ; start of WS lock area#Efn: .Long 0 ; event flag numberPid: .Long 0 ; target PID0Args: .Long 2 ; arg block for Kernel routine./ .Address pid ; address of target pid (ext).$ .Long 0 ; process name (unused). .Entry SET_EFN ^M <>% Movl @4(AP), pid ; get target PID., Movl @8(AP), efn ; get target event flag.' Cmpl efn, #31 ; check for valid EFN. Bgtr bad_efn$ Cmpl efn, #0 ; negative EFNs too.' Bgeq batten_down ; OK - let's do it.0Bad_efn: Movl #SS$_Illefc, R0 ; indicate bad EFN Error: Ret Batten_down:* $LKWSET_S - ; batten down the hatches. inadr = lock_vector Blbc R0, error' $CMKRNL_S - ; Jump to System Space. Routin = Set_Flag, - arglst = args Ret ; and finished.Set_Flag: .Word ^M 1 Jsb G^Exe$Nampid ; get internal PID (and go to ; warp factor 8." Blbs R0, ok ; did we get it OK?$ Movl R0, R6 ;no - save error code' Setipl #0 ; and return to sublight. Movl R0, R6 ; return error. Ret,Ok: Movl efn, R3 ; R3 contains flag number ; R1 already contains IPID Clrl R2 ; no priority boost.# Jsb G^Sch$Postef ; set his flag." Movl R0, R6 ; save status code.8 Unlock lockname=SCHED, - ; release spinlock and return$ newipl = #0 ; to sublight speed. Lock_End:$ Movl R6, R0 ; return status code." Ret ; and back to user space. .End**[TWADE.DECUSTAPE.KERNEL]SET-PROCNAME.MAR;1+,' . / 4O "-& 0123KPWO 56`g|67,}I89G HJN;*****************************************************************************; .Title SET_PROC_NAME-; Set the Process Name for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;=; This program works under VMS 5.4, and should work for 5.x; Command invocation is;&; $ PROCNAME "process-name" /id=;K; You may need to SET COMMAND PROC-NAME.CLD if the command is not in your"; DCLTABLES (which is unlikely).;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.0" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocksO;------------------------------------------------------------------------------ ; Macros.O;------------------------------------------------------------------------------) .Macro CHECK ?label ; check the status# Blbs R0, label ; and exit if not $EXIT_S R0 ; ok. Label: .Endm CHECK O;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------7Proc_prompt: .Ascid "NAME" ; prompt for the proc name/Pid_Prompt: .Ascid "ID" ; prompt for the PID.%Input_desc: .Long 15 ; user's input .Address proc_name-Pid_desc: .Long 8 ; user's PID in text form .Address pid_textPid_Text: .Blkb 8:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------ .Entry Start ^M <>! Pushal length ; input via CLD Pushaq input_desc Pushaq proc_prompt Calls #3, G^Cli$Get_Value Check) Pushal pid_desc ; get the target EPID. Pushaq pid_desc Pushaq pid_prompt Calls #3, G^Cli$Get_Value Check* Pushal epid ; Convert from hexadecimal( Pushaq pid_desc ; string to longword. Calls #2, G^Ots$Cvt_TZ_L Check) $LKWSET_S - ; batten down the hatches inadr = lock_range Check $CMKRNL_S - ; Warp drive on. routin = set_proc_name, - arglst = pid_args Ret ; return to DCLO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 0,Proc_name: .Blkb 15 ; actual process name.,Length: .Long 0 ; length of process name.O;------------------------------------------------------------------------------; Kernel Mode Code.;; Convert EPID to IPID, and poke the process name into the; target PCB.O;------------------------------------------------------------------------------* .Entry SET_PROC_NAME ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.$ ; (target PCB address returned ; in R4)., Movb length, - ; poke length of proc name Pcb$T_Lname(R4) ; into PCB8 Movc3 length, proc_name,- ; poke process name into PCB Pcb$T_Lname+1(R4)6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty. .End Start(*[TWADE.DECUSTAPE.KERNEL]SET-PROMPT.CLD;2+, './ 47-& 0123KPWO56`V747}I89G HJ Define Verb PROMPT Image SYS$DISK:[]SET-PROMPT. Parameter P1, Label=PROMPT, Value (required)7 Qualifier ID, Value (required), Default, nonnegatable(*[TWADE.DECUSTAPE.KERNEL]SET-PROMPT.MAR;9+,' . / 4O -& 0123KPWO 56 cߖ7F.}I89G HJN;***************************************************************************** .Title SET_PROMPT+; Set the DCL prompt for another process.;.; (c) Tom Wade T.Wade@vms.eurokom.ie 1991.;D; This program works under VMS 5.4, and should work for 5.2 & 5.3.; Command invocation is;$; $ PROMPT "prompt-string" /id=;L; You may need to SET COMMAND SET-PROMPT.CLD if the command is not in your"; DCLTABLES (which is unlikely).;; Privileges required: CMKRNL;J; Warning: This is Kernel Mode Code. It has been tested on a VAXstationA; 3100 using VMS 5.4, and in a cluster environment. While it is<; not anticipated that the program could cause a crash, theB; author offers no warranty that it won't. Use at your own risk. .Ident "V1.1" .Library "SYS$SHARE:LIB.MLB". .Link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH1 .Link "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH% $PCBDEF ; Process control blocks# $DYNDEF ; Dynamic memory types( $IPLDEF ; Interrupt Priority Levels" $ACBDEF ; AST Control Blocks.& $PRIDEF ; Priority boost classes. $SPLDEF ; SpinlocksO;------------------------------------------------------------------------------ ; Macros.O;------------------------------------------------------------------------------) .Macro CHECK ?label ; check the status# Blbs R0, label ; and exit if not $EXIT_S R0 ; ok. Label: .Endm CHECK O;------------------------------------------------------------------------------; Data used at low IPL.O;------------------------------------------------------------------------------8Prompt_prompt: .Ascid "PROMPT" ; prompt for the prompt./Pid_Prompt: .Ascid "ID" ; prompt for the PID.%Input_desc: .Long 32 ; user's input .Address prompt-Pid_desc: .Long 8 ; user's PID in text form .Address pid_textPid_Text: .Blkb 8:Lock_range: .Address lock_start ; where to start locking.- .Address lock_end ; where to stop locking.O;------------------------------------------------------------------------------; User Mode code.O;------------------------------------------------------------------------------ .Entry Start ^M <>! Pushal length ; input via CLD Pushaq input_desc Pushaq prompt_prompt Calls #3, G^Cli$Get_Value Check) Pushal pid_desc ; get the target EPID. Pushaq pid_desc Pushaq pid_prompt Calls #3, G^Cli$Get_Value Check* Pushal epid ; Convert from hexadecimal( Pushaq pid_desc ; string to longword. Calls #2, G^Ots$Cvt_TZ_L Check) $LKWSET_S - ; batten down the hatches inadr = lock_range Check $CMKRNL_S - ; Warp drive on. routin = set_prompt, - arglst = pid_args Ret ; return to DCLO;------------------------------------------------------------------------------; Data used at IPL$_SynchO;------------------------------------------------------------------------------ Lock_Start:Epid: .Long 0 ; Extended PidIpid: .Long 0 ; Internal Pid/Pid_args: .Long 1 ; argument block for NAMPID .Address epid .Long 0O;------------------------------------------------------------------------------; Kernel Mode Code.9; Convert EPID to IPID, build an ACB and sent him a nice; Kernel Mode AST.O;------------------------------------------------------------------------------+ .Entry SET_PROMPT ^M 1 Jsb G^Exe$Nampid ; get internal PID, raise IPL0 Blbc R0, exit ; to 8, and get SCHED spinlock.6 Bbc #Pcb$V_Inter, - ; check that the target process/ Pcb$L_Sts(R4), not_inter; is interactive.% Movl R1, ipid ; save internal PID.5 Movl #Prompt_Ast_Size, - ; allocate a chunk of pool' R1 ; big enough for the ACB + code5 Jsb G^Exe$Alononpaged ; R2 := address of pool area.4 Blbc R0, sub_light ; error - drop IPL and spinlock; Pushr #^M ; save regs from MOVC35 Movc3 #Prompt_Ast_size, - ; copy the code into pool Prompt_Ast, (R2)8 Popr #^M ; restore registers., Movw R1, Acb$W_Size(R2) ; load size of ACB/ Movb #Dyn$C_Acb, - ; load type of pool area. Acb$B_Type(R2)* Moval (R2),-0 Acb$L_Kast(R2) ; load address of Kernel AST.1 Clrb Acb$B_Rmod(R2) ; clear request mode bits.5 Bisb #Acb$M_Kast, - ; indicate special Kernel Mode Acb$B_Rmod(R2) ; AST.- Movl ipid, Acb$L_pid(R2) ; load target PID.* Movl R2, R5 ; SCH$QAST wants ACB in R5.4 Movl #Pri$_Ticom, R2 ; a helpful kick in the rear! Jsb G^Sch$Qast ; fire the AST.6 Unlock lockname=SCHED, - ; release spinlock and drop newipl=#0 ; warp drive.5Lock_end: Movl #SS$_Normal, R0 ; return success code."Exit: Ret ; Beam me up Scotty.BNot_Inter: Unlock lockname=SCHED, - ; don't hit a detached process" newipl=#0 ; or we Bugcheck :-(3 Movl #Lib$_Nocli, R0 ; say something comforting. Brb exit,Sub_light: Setipl #0 ; drop IPL to normal. Brb exitO;------------------------------------------------------------------------------E; The ACB followed by the Kernel AST to be delivered to the victim.O;------------------------------------------------------------------------------ Prompt_Ast:3Acb: .Blkb Acb$K_Length ; allocate space for ACB.&Length: .Long 0 ; Length of prompt.#Prompt: .Blkb 32 ; Prompt text. 'Prompt_Ast_Code: ; code begins here.& Pushl R6 ; save temporary register" Pushl R5 ; save address of ACB6 Movl #Ctl$Ag_Clidata, R6 ; get address of CLI stuff.5 Movl Ppd$L_Prc(R6), R6 ; get address of PRC block.3 Addb3 #3, W^length, - ; load length field (add 3- Prc_B_Promptlen(R6) ; for prompt control).7 Movc3 W^length, W^prompt, - ; move the prompt string. Prc_G_Prompt(R6)' Popl R0 ; restore ACB address to R0 Popl R6 ; restore R6.( Jmp G^Exe$Deanonpaged ; into oblivion.0 prompt_ast_size = .-prompt_ast ; size of pool. .End Start%*[TWADE.DECUSTAPE.KERNEL]SET-UIC.MAR;2+,'./ 4O-& 0123KPWO56"7c7=Y1}I89G HJO;****************************************************************************** .Title SET_PROCESS_UIC?; Program to set the UIC for this process. Calling sequence:;!; ret_code := SET_UIC (uic);6; Uic: Address of longword containing the UIC.;&; Returns: SS$_Normal for success.D; or other error indicating non-existence or remote nature of;$; Tom Wade ;>; WARNING: Program runs in kernel mode. While it has beenB; tested at VMS 5.4-3 & 5.5-1, please use at your own risk. .Library "SYS$SHARE:LIB.MLB" .Link "SYS$SYSTEM:SYS.STB" $PCBDEF .Entry SET_UIC ^M ' Movl @4(AP), R6 ; get the UIC value.. $CMKRNL_S - ; enter Kernel mode to set it. routin = SET_THE_UIC$ Ret ; give DCL the code we get. .Entry SET_THE_UIC ^M <>, Movl R6, Pcb$L_Uic(R4) ; load the new UIC.) Movl #SS$_Normal, R0 ; indicate success Ret ; and out of here. .End