From:	CBS%UK.AC.NSFNET-RELAY::BITNET.WKUVX1::MACRO32 14-MAR-1993 18:00:46.01
To:	UDAA055
CC:	
Subj:	Sys. Serv. Hook (Was RE: Imp terminates Qio !)

Via: UK.AC.NSFNET-RELAY; Sun, 14 Mar 93  18:00 GMT
Received: from ukcc.uky.edu by sun3.nsfnet-relay.ac.uk with Internet SMTP 
          id <sg.15000-0@sun3.nsfnet-relay.ac.uk>;
          Sun, 14 Mar 1993 17:59:36 +0000
Received: from UKCC.UKY.EDU by UKCC.uky.edu (IBM VM SMTP V2R2) with BSMTP 
          id 3375; Sun, 14 Mar 93 12:40:28 EST
Received: from WKUVX1.BITNET (NJE origin MXMAILER@WKUVX1) 
          by UKCC.UKY.EDU (LMail V1.1d/1.7f) with BSMTP id 4564;
          Sun, 14 Mar 1993 12:40:26 -0500
X-ListName: "VMS Internals, MACRO, and BLISS Discussions" 
            <MACRO32@WKUVX1.BITNET>
Warnings-To: <>
Errors-To: MacroMan@BITNET.WKUVX1
Original-Sender: MacroMan@BITNET.WKUVX1
Date: 13 Mar 1993 10:40:26 -0500 (EST)
From: "Brian J. Schenkenberger, VAXman" <SCHENKENBERG@MIL.Army.Monmouth-ETDL1>
Reply-To: MACRO32@BITNET.WKUVX1
Subject: Sys. Serv. Hook (Was RE: Imp terminates Qio !)
To: macro32 <macro32@BITNET.WKUVX1>
Message-ID: <01GVR8SDS7CI8WVYOS@MONMOUTH-etdl1.Army.MIL>
X-VMS-To: IN%"macro32@wkuvx1.bitnet"
MIME-version: 1.0
Content-transfer-encoding: 7BIT
Sender: MacroMan%BITNET.WKUVX1@EDU.UKY.UKCC

In a previous response to the problem posted under the original subject
title cited, I wrote:

>IF you want to exact this function on an individual basis I suggest something
>along the lines of the following:
>
>        1) Get a copy of my LEIs. Read the Cited article.  :-) :-)
>        2) Allocated a region of P1 space.
>        3) Copy the service vector for RMS$SETDDIR from the P1 vector
>           tables to a location in the allocated P1 region.
>        4) Copy the set prompt to reflect default direcotory routine
>           to allocated P1 region.
>        5) Insert a call to your P1 code into the service vector location
>           for RMS$SETDDIR.
>        6) All done.
>
>Let's generalize the action here.
>        1) You issue a $ SET DEFAULT [ABSOLUTE.ELSEWHERE]
>        2) The CLI routine, after parsing your requests, calls RMS$SETDDIR
>           to do the work.
>        3) The code you've place in RMS$SETDDIR calls your P1 code.
>        4) Your code, now holding the original RMS$SETDDIR service vector
>           code, issues the CHME #<setddir>.  (READ THE CITED ARTICLE! The
>           operand of the CHME instruction is never guaranteed to have the
>           same value.)
>        5) EXCEPTION! SCB+44(16)! EXE$CMODEXEC! EXE$SETDDIR! RET! REI!
>        6) Back in your P1 code.  Check return status.  If OK, then set
>           the prompt with the prompt setting code you loading in P1 region.
>           Return.
>        7) If status was not OK, simply return! Don't touch your prompt.
>
>{...}
>If you'd like some help with any of the short and schetchy details above,
>send me Email direct.

OK. Enough!  For those of you that asked and for those that didn't...
Here it is.

The program requires CMKRNL and TMPMBX privileges to install the hook.
_NO_ privileges are required after hook is installed.

BJS- /Brian Schenkenberger/Schenkenberg@Eisner.DECUS.Org/Space for Rent/
    /Independent Consult./Tmesis Consulting/Jackson, NJ/(908) 363-7551/
   /VMS Software Support/Vitronics, Inc./Eatontown, NJ/(908) 542-0600/
  /<VAXman or Schenkenberger>@Monmouth-ETDL1.Army.Mil/CIS: 70253,114/

Cut along the dotted line!
..............................................................................
;------------------------------------------------------------------------------
; Hook SYS$SETDDIR to provide the "Nick DeSmith" set prompt capability without
; the continual TQE expiration and subsequent delivery of an exec. mode AST.
;------------------------------------------------------------------------------
; After 'HOOK'ing the system service vector table, a call to the service will:
; 1) mask the registers as before
; 2) encounter the 'new' JMP instruction and branch to the code segment we
;    have loaded in P1 space.
; 3) will execute the CHME instruction copied from the original vector
; 4) check the status returned from the dispatched routine
; 5) if error, then return immediately.  Else...
; 6) Assign a user mode channel to the temporary mailbox (more on this later)
; 7) write a null string to the mailbox to set off the executive mode write
;    attention AST.
; 8) Executive mode AST modifies prompt string (UREW) and requeues the write
;    attention AST for next time around.
;------------------------------------------------------------------------------
; Author: /Brian Schenkenberger/Ind. Consult./TMESIS Consulting/Jackson, NJ/
;------------------------------------------------------------------------------
        .TITLE  SSHOOK  Demo of System service vector 'HOOK' technique
        .IDENT  "VMS v5.x%3.070"

        .LIBRARY        "SYS$LIBRARY:LIB"       ; check this library too
        .LINK           "SYS$SYSTEM:SYS.STB"    ; link w/ system symbol table
        .LINK           "SYS$SYSTEM:DCLDEF.STB" ; link with DCL symbol table
;------------------------------------------------------------------------------
        $DVIDEF         ; $GETDVI item list codes
        $IPLDEF         ; IPL definitions
        $OPDEF          ; VAX opcode definitions
        $PRTDEF         ; VAX page protections
;----------------------------------------------------------------------------
; Mailbox file protection access - user class offset definitions
;----------------------------------------------------------------------------
SYSTEM  = 0     ;    15141312 1110 9 8  7 6 5 4  3 2 1 0
OWNER   = 4     ;   ,--------,--------,--------,--------.
GROUP   = 8     ;   | World  | Group  | Owner  | System |
WORLD   = 12    ;   `--------`--------`--------`--------'
                ;     L P W R  L P W R  L P W R  L P W R
;----------------------------------------------------------------------------
; Mailbox file protection access - privilege mask definitions
;----------------------------------------------------------------------------
READ    = ^b0001
WRITE   = ^b0010
PHYSICAL= ^b0100        ; * not used in mailbox I/O.  Merely a placeholder.
LOGICAL = ^b1000
;----------------------------------------------------------------------------
MBXPRO  = <<READ!WRITE!LOGICAL>@OWNER>
;------------------------------------------------------------------------------
        .PSECT  $$DATA,PIC,USR,CON,REL,SHR,NOEXE,RD,WRT,NOVEC,PAGE
SS.PAGE:        .BLKB   512             ; System Service vector page storage
VECTOR:         .QUAD   0               ; address range
VECTOR2:        .QUAD   0               ; address range
BWPAGE:         .LONG   0               ; byte offset to System Service
;---
SS.HOOK:                                ; System Service vector 'HOOK'
SS.MASK:        .WORD   0               ; .ENTRY <system service>,^M<mask>
SS.JMP:         .BYTE   OP$_JMP         ; VAX JMP instruction
SS.OPERAND_SPEC:.BYTE   ^X9F            ; Operand specifier, Absolute addr.
SS.ABSOLUTE_ADR:.LONG   0               ; 'HOOK' routine address goes here
;---
DVI.ITMLST:     .WORD   10,DVI$_DEVNAM  ; GETDVI item list to obtain the
                .LONG   0               ; mailbox device name string
                .LONG   0,0

;------------------------------------------------------------------------------
; The 'HOOK' routine assumes that the process will not have CMEXEC privilege
; to modify the UREW page where the prompt string is stored.  Therefore, in
; order to have exec. access privilege, an exec. mode AST is delivered to the
; process to change the prompt.  This is accomplished with a mailbox write
; attention (executive mode) AST which is enabled on a temporary mailbox.  To
; keep the AST and the mailbox 'alive' after image rundown, the mailbox is
; created and a channel is assigned at exec. mode.  The write attention AST
; is also queued at exec. mode so that it will have the elevated access mode
; necessary to modify the UREW page.
; ---
; Do to the protection schemes of VMS, a user mode I/O request can not be
; posted to a channel assigned at a more privileged access mode.  However, a
; User mode channel _can_ be assigned to the mailbox.  The routine assigns a
; channel to the mailbox and then, issues a write to deliver the executive
; mode write attention AST.
;------------------------------------------------------------------------------
SS_HOOK_RTN:                            ; Start of 'HOOK' routine
CHME:   .LONG   0                       ; we'll load current CMMx #<#> here
        BLBS    R0,10$                  ; check system service return status
        RET                             ; something's wrong... tell user
;---
10$:    MOVAL   -(SP),R0                ; stk sp. for chan #, save adr. in r0
        $ASSIGN_S       DEVNAM=L^MBXNAM,-       ; assign a user mode channel
                        CHAN=(R0)               ; to the exec mode held mbx
        MOVL    (SP),R0                 ; get channel number from the stack
        $QIOW_S EFN=#45,CHAN=R0,-       ; write to mbx to trigger the exec
                FUNC=#IO$_WRITEVBLK,-   ; mode write attention AST
                P1=#0,P2=#0             ; which will modify the prompt string
        CALLS   #1,G^SYS$DASSGN         ; can the channel and clean up stack
        MOVL    #RMS$_NORMAL,R0         ; tell caller everything's alright
        RET     ; we return now to the previous program already in progress!
;---
PMTAST: .WORD   ^M<R2,R3,R4,R5,R6,R7,R8>; save'em trashed registers
        MOVAB   @#CTL$AG_CLIDATA,R7     ; get base of the CLI data area
        IFNORD  #4,PPD$L_PRC(R7),30$    ; is the PPD area accessible!?
        MOVL    PPD$L_PRC(R7),R7        ; get base of proc. perm. data area
        IFNOWRT #PRC_S_PROMPT,-         ; is prompt string area writeable??
                PRC_G_PROMPT(R7),30$    ;==- if not, get outta here!

        MOVAB   @#PIO$GT_DDSTRING,R8    ; get the def dir (ascic) string

        MOVZBL  (R8)+,R6                ; get the length of the ddstring
        CMPL    R6,#PRC_S_PROMPT-1      ; will it fit in the prompt?
        BLSSU   20$                     ; branch 20$ if it fits
        SUBL2   #PRC_S_PROMPT-1,R6      ; how much wont fit in the prompt?
        ADDL2   R6,R8                   ; chop that much off the beginning
        MOVL    #PRC_S_PROMPT-1,R6      ; output all that we got.

20$:    MOVC3   R6,(R8),PRC_G_PROMPT(R7)        ; copy ddstring to prompt
        ADDB3   #4,R6,PRC_B_PROMPTLEN(R7)       ; update the prompt length
        MOVB    #^a/ /,PRC_G_PROMPT(R7)[R6]     ; add space to end of prompt

30$:    $QIOW_S EFN=#45,CHAN=L^CHAN_E,-         ; read mailbox data.
                FUNC=#IO$_READVBLK!IO$M_NOW,-   ; flushes previous write
                P1=#0,P2=#0
        $QIO_S  EFN=#45,CHAN=L^CHAN_E,-         ; requeue the write attention
                FUNC=#IO$_SETMODE!IO$M_WRTATTN,-        ; AST in EXEC mode
                P1=L^PMTAST,P2=#0
        MOVL    #RMS$_NORMAL,R0         ; tell caller everything's alright
        RET                             ; done in executive mode
;---
.ALIGN LONG
CHAN_E: .LONG   0       ; storage for the executive mode channel number
MBXNAM: .LONG   10      ; mbx name descriptor.  Length of 10 characters.
NAMPTR: .LONG   0       ; filled in later. .address not PIC in loaded code
NAMBUF: .ASCII  /_MBAxxxx: /    ; buffer for mbx name.  filled by $GETDVI
;---
ROUTINE_LEN=.-SS_HOOK_RTN               ; size o' routine to be P1 loaded
;------------------------------------------------------------------------------
        .PSECT  $$CODE,PIC,USR,CON,REL,SHR,EXE,RD,NOWRT,NOVEC,PAGE
        .ENTRY  INSTALL$SS_HOOK,0
        CMPL    G^SYS$SETDDIR,G^RMS$SETDDIR     ; Already loaded?
        BEQL    10$                             ; If EQL... NO
        MOVL    #SS$_ILLSELF,R0         ; signal reference to itself
        RET

10$:    MOVAB   G^SYS$SETDDIR,R0        ; Get VA of the SYS$SETDDIR vector
        BICL3   #^X1FF,R0,VECTOR        ; First VA in the associated page
        ADDL3   #^X1FF,VECTOR,VECTOR+4  ; Last VA in the associated page
        BICL3   #^C^X1FF,R0,BWPAGE      ; BYTE within page offset

        MOVW    (R0)+,SS.MASK           ; New vector should preserve mask
        MOVL    (R0),CHME               ; new routine needs current CHME #

        MOVC3   #^X200,@VECTOR,SS.PAGE  ; Save contents of SYS$SETDDIR page

        $CMEXEC_S       ROUTIN=EXEC$ROUTINE     ; to executive mode
        BLBS    R0,20$
        RET

20$:    MOVL    BWPAGE,R0               ; byte offset to service vector
        MOVAB   SS.PAGE[R0],R0          ; locate it in the copied page
        MOVQ    SS.HOOK,(R0)            ; replace original with 'HOOK'

        $CMKRNL_S       ROUTIN=KRNL$ROUTINE     ; to kernel mode
        RET                             ; all done!
;------------------------------------------------------------------------------
        .ENTRY  EXEC$ROUTINE,^M<R2,R3,R4,R5>
        MOVL    #ROUTINE_LEN,R1                 ; place length of code in r1
        JSB     G^EXE$ALOP1PROC                 ; allocate that much p1 space
        BLBS    R0,10$                          ; return if error occurred
        RET

10$:    MOVL    R2,SS.ABSOLUTE_ADR              ; need to know where to jump
        MOVC3   #ROUTINE_LEN,SS_HOOK_RTN,(R2)   ; move code into p1 area
        MOVL    SS.ABSOLUTE_ADR,R2      ; recover base of P1 allocation

_CHAN_E=CHAN_E-SS_HOOK_RTN      ; base relative offset to exec channel storage
_PMTAST=PMTAST-SS_HOOK_RTN      ; base relative offset to write attention AST
_NAMPTR=NAMPTR-SS_HOOK_RTN      ; base relative offset to mbx descr. pointer
_NAMBUF=NAMBUF-SS_HOOK_RTN      ; base relative offset to mbx descr. buffer

        $CREMBX_S       CHAN=_CHAN_E(R2),-      ; create temp. mbx.  Assigning
                        PROMSK=#^C<MBXPRO>      ; channel at exec mode to keep
        BLBC    R0,20$                          ; mbx alive after image rundown
        MOVAB   _NAMBUF(R2),_NAMPTR(R2) ; move address of buffer into pointer
        MOVAB   _NAMBUF(R2),DVI.ITMLST+4; move address of buffer into itmlst

        $GETDVI_S       CHAN=_CHAN_E(R2),-      ; get the mbx device name.
                        ITMLST=DVI.ITMLST
        BLBC    R0,20$

        $QIO_S  EFN=#45,CHAN=_CHAN_E(R2),-      ; queue the executive mode
                        FUNC=#IO$_SETMODE!IO$M_WRTATTN,-        ; write
                        P1=_PMTAST(R2),P2=#0    ; attention AST
        MOVL    #SS$_NORMAL,R0                  ; done in executive mode
20$:    RET
;------------------------------------------------------------------------------
; The vector we want to 'hook' is in a page of virtual address space that was
; PFN mapped.  (Note: Window bit (#21) is set in PTE
;---
;SDA> SHOW PROCESS/PAGE_TABLE SYS$SETDDIR;0
;Process page table
;------------------
;        ADDRESS     SVAPTE    PTE **    TYPE  PROT  BITS PAGTYP    LOC STATE
;       7FFEE200    8095FFC4 FC202469    VALID UR   M   K
;                                ****
;SDA> EVALUATE/PTE FC2024B4      .-- Page was PFN mapped (Window bit set)
;                                |
;|31       28|27       24|23     | 20|19       16|15       12|11        8|7
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;|1 |  1 1 1 1  |1 |--| 0 0 |--| 1|                          002469
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;Vld  Prot= UR   M     Own=K     W                      Page Frame Number
;       Page is Active and Valid                                 Y
;---                                                             |
; This page frame number is used by all processes which have the |same VA pages
; PFN mapped into the process.  It is also the PFN of the S0 service vector.
;---                                                             |
;SDA> SHOW PAGE_TABLE RMS$SETDDIR;1                              |
;System page table                                               |-(Same PFN!)
;-----------------                                               |
;        ADDRESS     SVAPTE    PTE **    TYPE  PROT  BITS PAGTYP |  LOC STATE
;       80000400    80B26A08 FC002469    VALID UR   M   K        |
;                                ****                            |
;SDA> EVALUATE/PTE FC0024B4                                      |
;                                                                |
;|31       28|27       24|23       20|19       16|15       12|11 v      8|7
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;|1 |  1 1 1 1  |1 |--| 0 0 |--| 0|                          002469
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;Vld  Prot= UR   M     Own=K     W                      Page Frame Number
;       Page is Active and Valid
;---
; To modify the system service vector on a per-process basis, we need the VA
; page to be mapped by a unique PFN.  To do this, we will save the contents
; of the current VA page (previously copied to SS.PAGE in user mode) and then,
; delete this VA page.  A new PFN mapping is created using the $CRETVA system
; service, specifying the original page's VAs.  The saved contents (SS.PAGE)
; are copied to this newly created demand zero (DZRO) page and protection is
; set to that of other pages in the system service vector table.  NOTE: Since
; we have deleted the VA page containing the system service vectors from the
; process, we can NOT use the system service macros or reference the vectors
; in the P1 table until the contents are copied back into the new VA Page.
; Therefore, we will call the service vectors from the S0 table.
;------------------------------------------------------------------------------
; RTFM: VAX/VMS IDSM v5.2, Ruth Goldenberg, EY-C171E-DP, Ch.15, Mem. Mgt. S.S.
; Sec: 15.4.1.2 PFN-Mapped Process Section, Sec: 15.7 $SETPRT System Service,
; Sec: 15.3.1  $CRETVA System Service,  Sec: 15.5.3  $DELTVA System Service,
;------------------------------------------------------------------------------
        .ENTRY  KRNL$ROUTINE,^M<R2,R3,R4,R5>
        MOVAB   KRNL$ROUTINE,VECTOR2    ; lock KRNL$ROUTINE in the working
        MOVAB   KRNL$RTN_END,VECTOR2+4  ; set to prevent page faulting with
        $LKWSET_S       INADR=VECTOR2   ; IPL>=IPL$_ASTDEL
        BLBS    R0,10$
        RET

10$:    MOVAB   VECTOR,VECTOR2          ; lock page containing VECTOR in the
        MOVAB   VECTOR+4,VECTOR2+4      ; working set.  We will be touching
        $LKWSET_S       INADR=VECTOR2   ; this also at IPL>=IPL$_ASTDEL
        BLBS    R0,20$
        RET
;------------------------------------------------------------------------------
; Raise IPL to IPL$_ASTDEL to block AST delivery.  Specifically, kernel mode
; ASTs which reference the system service vector table in process P1 space.
; There may be no system service vector page available then AST is delivered!
; Ouch! Access violation in kernel mode.  System shuts down, _REAL_ _FAST_!!!
;---
; For similar reasons, the newly created DZRO page is LOCKed into the working
; set to avoid problems of faulting in the page should the page _NOT_ be valid
; when/if it is referenced at elevated IPLs.  Ouch! Nasty PGFIPLHI bugcheck!!!
;------------------------------------------------------------------------------
20$:    SETIPL  #IPL$_ASTDEL            ; block AST delivery

        CLRQ    -(SP)                   ; acmode & retadr (not specified)
        PUSHAB  VECTOR                  ; inadr
        CALLS   #3,G^EXE$DELTVA         ; need to call S0 vector here because
        BLBS    R0,30$                  ; we'll have nothing to return to!!!
        RET
                                        ; out with the old; in with the new
30$:    CLRQ    -(SP)                   ; acmode & retadr (not specified)
        PUSHAB  VECTOR                  ; inadr
        CALLS   #3,G^EXE$CRETVA         ; create DZRO page for S.S. vectors
        BLBS    R0,50$                  ; if an error occurs here, we'd best
                                        ; $#!+can the process!
40$:    SETIPL  #0                      ; lower IPL or we'll crash on $EXIT
        PUSHL   #SS$_NORMAL
        CALLS   #1,G^EXE$EXIT           ; bye bye

50$:    CLRQ    -(SP)                   ; acmode & retadr (not specified)
        PUSHAB  VECTOR                  ; inadr
        CALLS   #3,G^EXE$LKWSET         ; lock 'em down
        BLBC    R0,40$                  ; Error? Should'nt be! Outta here!

        MOVC3   #^X200,SS.PAGE,@VECTOR  ; put the table back!
;------------------------------------------------------------------------------
; Without an intervening REI, it is unwise use a modified instruction stream!
; Therefore, we'll call SETPRT in the S0 table.
;------------------------------------------------------------------------------
        PUSHL   #0                      ; prvprt (not specified)
        PUSHL   #PRT$C_UR               ; prot
        CLRQ    -(SP)                   ; acmode & retadr (not specified)
        PUSHAB  VECTOR                  ; inadr
        CALLS   #5,G^EXE$SETPRT         ; set page prot. like rest of table
        RET
KRNL$RTN_END:
;------------------------------------------------------------------------------
; The new service vector table now has the look and feel of the original with
; two exceptions. 1) The vector for SYS$SETDDIR has been modified to call the
; 'HOOK' routine. 2) The Virtual Page is mapped through a unique PFN.
;---
;SDA> SHOW PROCESS/PAGE_TABLE SYS$SETDDIR;0
;Process page table
;------------------
;        ADDRESS     SVAPTE    PTE       TYPE  PROT  BITS PAGTYP    LOC STATE
;       7FFEE200    809307C4 F8001E7A    VALID UR       K PROCESS ACTIVE  87
;
;SDA> EVALUATE/PTE F8001E69
;
;|31       28|27       24|23       20|19       16|15       12|11        8|7
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;|1 |  1 1 1 1  |0 |--| 0 0 |--| 0|                          001E7A
;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+-->
;Vld  Prot= UR   M     Own=K     W                      Page Frame Number
;       Page is Active and Valid
;------------------------------------------------------------------------------
        .END    INSTALL$SS_HOOK
