From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  1-JUN-1991 05:35:21.70
To:	ARISIA::EVERHART
CC:	
Subj:	Program to set other's DCL prompt (VMS 5.4)

From:	RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP@CRDGW2
To:	Everhart@Arisia@MRGATE

Received:  by crdgw1.ge.com (5.57/GE 1.99)
	 id AA26302; Fri, 31 May 91 14:27:54 EDT
Received: From PUCC.PRINCETON.EDU by CRVAX.SRI.COM with TCP; Fri, 31 MAY 91 07:04:28 PDT
Received: from IRLEARN.UCD.IE by pucc.PRINCETON.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 4732; Fri, 31 May 91 10:04:15 EDT
Received: from mailgate.ucd.ie by IRLEARN.UCD.IE (Mailer R2.07) with BSMTP id
 8572; Fri, 31 May 91 15:03:15 GMT
Received: from enterprise.eurokom.ie by mailgate.ucd.ie; Fri, 31 May 91 13:51
 GMT
Received: from kirk.eurokom.ie by enterprise.eurokom.ie with PMDF#10597; Fri,
 31 May 1991 15:03 WET
Date: Fri, 31 May 1991 15:03 WET
From: "Tom Wade, VMS Systems" <T.Wade%cc.ucd.ie@pucc.PRINCETON.EDU>
Subject: Program to set other's DCL prompt (VMS 5.4)
Sender: Tom Wade VMS Systems <T_WADE%kirk.eurokom.ie@pucc.PRINCETON.EDU>
To: info-vax@kl.sri.com
Cc: pjs@euclid.jpl.nasa.gov
Message-Id: <E108B0F580000068@kirk.eurokom.ie>
X-Envelope-To: pjs@euclid.jpl.nasa.gov, info-vax@kl.sri.com
X-Vms-To: in%"info-vax@kl.sri.com"
X-Vms-Cc: in%"pjs@euclid.jpl.nasa.gov"

Greetings,

I have rewritten the program to change the DCL prompt for another process, to
work under VMS 5.4.  To build, just

        $ MACRO SET-PROMPT
        $ LINK/NOTRACE SET-PROMPT

Edit the SET-PROMPT.CLD, so that the line starting IMAGE points to where you
put the EXE.

        $ SET COMMAND SET-PROMPT

then find somebody in the middle of Datatrieve, note his PID and type:

        $ PROMPT "DTR>" /id=<pid>

This will set his DCL prompt to "DTR>", assuming, of course, that you have
CMKRNL privileges.

I have tested the code on a workstation under the following conditions:

        * Tested under VMS 5.4 and 5.4-2.
        * Correctly sets prompt for other interactive processes.
        * Truncates long prompts.
        * Gives error message when target process is not interactive (bit
          PCB$V_INTER is clear in PCB$L_STS).
        * Gives error message when target process is on another node in the
          cluster.
        * Gives error message when target process does not exist.

I have *not* tested it on processes running CLIs other than DCL.  Feedback
would be appreciated.

***** Warning ***** Warning ***** Warning ***** Warning ***** Warning *****
THIS IS KERNEL MODE CODE.  ERRORS OCCURRING IN KERNEL MODE NORMALLY RESULT IN
FATAL BUGCHECKS. WHILE THIS PROGRAM HAS BEEN TESTED BY THE IMPLEMENTOR, NO
WARRANTY IS STATED OR IMPLIED AS TO THE BEHAVIOR OF THIS PROGRAM ON YOUR
MACHINE.  IT IS YOUR RESPONSIBILITY TO TEST IT TO YOUR SATISFACTION.
***** Warning ***** Warning ***** Warning ***** Warning ***** Warning *****

-------------- File SET-PROMPT.MAR --------------------------------------------
;*****************************************************************************

                .Title  SET_PROMPT

;   Set the DCL prompt for another process.
;
;   (c)  Tom Wade  T.Wade@vms.eurokom.ie 1991.
;
;   This program works under VMS 5.4, and should work for 5.2 & 5.3.
;   Command invocation is
;
;       $ PROMPT "prompt-string" /id=<pid>
;
;   You may need to SET COMMAND SET-PROMPT.CLD if the command is not in your
;   DCLTABLES (which is unlikely).
;
;   Privileges required:        CMKRNL
;
;   Warning:    This is Kernel Mode Code.  It has been tested on a VAXstation
;               3100 using VMS 5.4, and in a cluster environment.  While it is
;               not anticipated that the program could cause a crash, the
;               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_SEARCH
                .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                         ; Spinlocks

;------------------------------------------------------------------------------
;       Macros.
;------------------------------------------------------------------------------

                .Macro  CHECK   ?label          ; check the status
                        Blbs    R0,     label   ; and exit if not
                        $EXIT_S R0              ; ok.
                Label:
                .Endm   CHECK

;------------------------------------------------------------------------------
;       Data used at low IPL.
;------------------------------------------------------------------------------

Prompt_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_text
Pid_Text:       .Blkb   8

Lock_range:     .Address lock_start             ; where to start locking.
                .Address lock_end               ; where to stop locking.


;------------------------------------------------------------------------------
;   User Mode code.
;------------------------------------------------------------------------------

                .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 DCL


;------------------------------------------------------------------------------
;       Data used at IPL$_Synch
;------------------------------------------------------------------------------

Lock_Start:
Epid:           .Long   0                       ; Extended Pid
Ipid:           .Long   0                       ; Internal Pid

Pid_args:       .Long   1                       ; argument block for NAMPID
                .Address epid
                .Long   0


;------------------------------------------------------------------------------
;       Kernel Mode Code.
;               Convert EPID to IPID, build an ACB and sent him a nice
;               Kernel Mode AST.
;------------------------------------------------------------------------------

                .Entry  SET_PROMPT      ^M <R2, R3, R4, R5, R6>

                Jsb     G^Exe$Nampid            ; get internal PID, raise IPL
                Blbc    R0,     exit            ; to 8, and get SCHED spinlock.
                Bbc     #Pcb$V_Inter, -         ; check that the target process
                        Pcb$L_Sts(R4), not_inter; is interactive.
                Movl    R1,     ipid            ; save internal PID.

                Movl    #Prompt_Ast_Size, -     ; allocate a chunk of pool
                        R1                      ; big enough for the ACB + code
                Jsb     G^Exe$Alononpaged       ; R2 := address of pool area.
                Blbc    R0,     sub_light       ; error - drop IPL and spinlock

                Pushr   #^M <R0, R1, R2, R3, R4, R5> ; save regs from MOVC3
                Movc3   #Prompt_Ast_size, -     ; copy the code into pool
                        Prompt_Ast, (R2)
                Popr    #^M <R0, R1, R2, R3, R4, R5> ; 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   <Prompt_Ast_code-Prompt_Ast>(R2),-
                        Acb$L_Kast(R2)          ; load address of Kernel AST.
                Clrb    Acb$B_Rmod(R2)          ; clear request mode bits.
                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.
                Movl    #Pri$_Ticom, R2         ; a helpful kick in the rear
                Jsb     G^Sch$Qast              ; fire the AST.

                Unlock  lockname=SCHED, -       ; release spinlock and drop
                        newipl=#0               ; warp drive.

Lock_end:       Movl    #SS$_Normal,    R0      ; return success code.
Exit:           Ret                             ; Beam me up Scotty.

Not_Inter:      Unlock  lockname=SCHED, -       ; don't hit a detached process
                        newipl=#0               ; or we Bugcheck :-(
                Movl    #Lib$_Nocli, R0         ; say something comforting.
                Brb     exit

Sub_light:      Setipl  #0                      ; drop IPL to normal.
                Brb     exit

;------------------------------------------------------------------------------
;   The ACB followed by the Kernel AST to be delivered to the victim.
;------------------------------------------------------------------------------

Prompt_Ast:
Acb:            .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 ACB
                Movl    #Ctl$Ag_Clidata, R6     ; get address of CLI stuff.
                Movl    Ppd$L_Prc(R6),   R6     ; get address of PRC block.
                Addb3   #3,  length, -          ; load length field (add 3
                        Prc_B_Promptlen(R6)     ; for prompt control).
                Movc3   length, 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.

                prompt_ast_size = .-prompt_ast  ; size of pool.

                .End    Start
-------------------------------------------------------------------------------
--------------- File SET-PROMPT.CLD ------------------------------
        Define Verb  PROMPT
                Image   SYS$DISK:[]SET-PROMPT
                Parameter       P1, Label=PROMPT, Value (required)
                Qualifier       ID, Value (required), Default, nonnegatable
-----------------------------------------------------------------------------

------------------------------------------------------------------------------
Tom Wade            |  Internet:    T.Wade@vms.eurokom.ie  (all domain mailers).
Speaker To VAXes    |  Bitnet:      T_WADE@EUROKOM
EuroKom             |  PSI-Mail:    PSI%272431001992::T.WADE
University College  |  DEC EASYnet: DECWRL::"t.wade@vms.eurokom.ie"   (VMS Mail)
Belfield            |  JANET:       t.wade%ie.eurokom.vms@UK.AC.EARN-RELAY
Dublin 4            |  X400:        [Address Exceeds 65536 byte buffer]
Ireland             |  Telex:       (0500) 91178 UCD EI  ("TO: WADE" at start)
--------------------+----------------------------------------------------------
Voice:+353-1-2697890|  Official Disclaimer:  "This is not a disclaimer"
Fax:  +353-1-2838605|          Unix  ....  Just say No !
-------------------------------------------------------------------------------


