        .title  exttrnlnm
; Copyright (c) 1994 Glenn C. Everhart
; All Rights Reserved
;
;  Author     : Arne Vajhøj
;  Modified by Glenn C. Everhart
;
;  Programmed : july 1992 by Arne Vajhøj
;
;  Purpose    : translate logical for another process
;
        .library "sys$library:lib"
        .link   "sys$system:sys.stb"/selective_search
        $SFDEF
        $IPLDEF
        $ACBDEF
        $DYNDEF
        $PCBDEF
        $PRIDEF
        $PSLDEF
        $SSDEF
        $LNMSTRDEF
EFN=17
LNM$C_NAMLENGTH=255
        .psect  EXTTRNLNM quad,pic,con,lcl,noshr,exe,wrt
pid:    .blkl   1
prcnam: .blkl   1
stat:   .blkl   1
        .blkl   1
        .blkb   LNM$C_NAMLENGTH
;
;  Entry : EXTTRNLNM ( PID, PRCNAM , LNM , TBLNM , RESSTR , RESLEN )
;
;  Functionality : Translates a logical in the context of another process.
;                  Particular usefull for translating logicals in
;                  another users LNM$PROCESS_TABLE.
;
;  Notes : Both LNM and TBLNM are case-sensitive (they should normally
;          be specified in upper-case).
;
;          The translation are being performed in user-mode, that is
;          logicals in less priviliged modes overides logicals in more
;          priviliged modes.
;
;  Arguments : PID
;              pid of target process
;              longword passed by reference
;              readonly
;
;              PRCNAM
;              process name of target process
;              fixed length chracter string passed by descriptor
;              readonly
;
;              LNM
;              logical name to translate
;              fixed length chracter string passed by descriptor
;              readonly
;
;              TBLNM
;              logical name table name to lokkup in
;              fixed length chracter string passed by descriptor
;              readonly
;
;              RESSTR
;              resultant string
;              fixed length chracter string passed by descriptor
;              writeonly
;
;              RESLEN
;              resultant string length
;              longword passed by reference
;              writeonly
;
;  Priviliges required : CMKRNL    to enter kernel mode
;                        WORLD     to translate from pid/prcnam to pcb for
;                                  an arbitrary process
;
;  Return codes : SS$_NORMAL        translation succesfull
;                 SS$_NOPRIV        no CMKRNL privilige present/
;                                   no access to logical name table
;                 SS$_NOLOGNAM      no such logical name found in table/
;                                   no such table
;                 SS$_NONEXPR       no such process
;                 SS$_REMOTE_PROC   process not on this node in
;                                   cluster
;
;  Disclaimer : This is a kernel-mode-hack using several undocumented
;               features of VMS. I truly believe, that it will work
;               on any VMS 5.x system, but you use this code entirely at
;               your own risk.
;
;  Ackknowledge : Thanks to Hunter Goatley for providing much help and
;                 guiding.
;
;  Bugs : Please mail bug-reports to ARNE@KO.HHS.DK (Arne Vajhøj).
;
        .entry  exttrnlnm,^m<r2,r3,r4,r5,r8>
        movl    12(ap),r1
        movzwl   (r1),lnmstrlen
        movc3   lnmstrlen,@4(r1),lnmstr
        movl    16(ap),r1
        movzwl   (r1),tblstrlen
        movc3   tblstrlen,@4(r1),tblstr
;
        pushab  qkast_end
        pushab  qkast_start
        pushl   #0
        pushl   #0
        pushab  8(sp)
        calls   #3,G^SYS$LKWSET         ; lock pages in working-set
        blbc    r0,101$
;
        movl    4(ap),pid
        movl    8(ap),prcnam
;
        pushl   #0
        pushab  qkast
        calls   #2,G^SYS$CMKRNL         ; call qkast in kernel mode
        blbc    r0,100$
;
        pushl   #EFN
        calls   #1,G^SYS$WAITFR         ; wait for eventflag to be set
        movl    stat,r0                 ; test status from LNM$SERCH_ONE
        blbc    r0,100$
;
        movl    stat+4,@24(ap)
        movl    20(ap),r1
        movc3   stat+4,stat+8,@4(r1)
        movl    #SS$_NORMAL,r0
;
100$:
	movl	r0,r8
        pushab  qkast_end
        pushab  qkast_start
        pushl   #0
        pushl   #0
        pushab  8(sp)
; ensure we don't leave the range locked all the time.
	calls	#3,g^sys$ulwset	;unlock working set
	movl	r8,r0
	ret
101$:
	ret
qkast_start:
        .entry  qkast,^m<r2,r3,r4,r5>
        movab   G^EXE$SIGTORET,SF$A_HANDLER(fp) ; set exception handler
        movl    r4,pcb                  ; save pcb
        movab   stat,adr                ; save address
        pushl   prcnam
        pushl   pid
        pushl   #2
        movl    sp,ap
        jsb     G^EXE$NAMPID            ; convert external->internal PID
        addl2   #12,sp
        blbs    r0,100$
        brw     err
100$:   UNLOCK  SCHED,newipl=#IPL$_ASTDEL
        cmpl    r1,G^SCH$GL_SWPPID      ; test if swapper
        bneq    200$
        movl    #SS$_NONEXPR,r0
        brw     err
200$:   addl3   #kast_size,#ACB$K_LENGTH,r1
        jsb     G^EXE$ALONONPAGED       ; allocate ACB
        blbs    r0,300$
        brw     err
300$:   movw    r1,ACB$W_SIZE(r2)       ; fill ACB fields
        movb    #DYN$C_ACB,ACB$B_TYPE(r2)
        movb    #ACB$M_KAST!PSL$C_KERNEL,ACB$B_RMOD(r2)
        movl    PCB$L_PID(r4),ACB$L_PID(r2)
        movab   ACB$K_LENGTH(r2),ACB$L_KAST(r2)
        pushl   r2
        movc3   #kast_size,kast_code,ACB$K_LENGTH(r2) ; move AST code
        popl    r2
        pushr   #^m<r2,r4>
        movl    #EFN,r3
        movl    pcb,r4
        jsb     G^SCH$CLREF             ; clear event-flag
        popr    #^m<r2,r4>
        movl    r2,r5
        movl    #PRI$_TICOM,r2
        jsb     G^SCH$QAST              ; queue AST
        SETIPL  #0                      ; reset IPL
        movl    #SS$_NORMAL,r0          ; ok
        ret                             ; return
err:    SETIPL  #0                      ; reset IPL
        ret                             ; return
kast_code:
        pushr   #^m<r5,r6>
        movl    lnmstrlen,r0
        movab   lnmstr,r1
        movl    tblstrlen,r2
        movab   tblstr,r3
        movl    #PSL$C_USER,r5
        movab   outbuf,r6
        jsb     G^LNM$SEARCH_ONE        ; search for logical
        popr    #^m<r5,r6>
        movl    r0,retcod
;
        movl    pcb,r4
        movl    PCB$L_PID(r4),ACB$L_PID(r5)
        addl2   #kast_code_size,ACB$L_KAST(r5)
        movb    #ACB$M_KAST!PSL$C_KERNEL,ACB$B_RMOD(r5)
        movl    #0,r2
        jmp     G^SCH$QAST              ; requeue AST
;
kast_code_size=.-kast_code
kast_code_2:
        pushr   #^m<r4,r5>
        movl    adr,r1
        movl    retcod,(r1)
        blbc    retcod,100$
        cvtbl   outbuf+LNMX$T_XLATION,4(r1)
        movc3   4(r1),outbuf+LNMX$T_XLATION+1,8(r1) ; save translation
100$:   popr    #^m<r4,r5>
;
        movl    PCB$L_PID(r4),r1
        movl    #0,r2
        movl    #EFN,r3
        jsb     G^SCH$POSTEF            ; set event-flag
        movl    r5,r0
        jmp     G^EXE$DEANONPAGED       ; deallocate ACB and disappear
;
pcb:    .blkl   1
adr:    .blkl   1
retcod: .blkl   1
lnmstrlen:
        .blkl   1
lnmstr: .blkb   32
tblstrlen:
        .blkl   1
tblstr: .blkb   32
outbuf: .blkb   LNMX$T_XLATION+LNM$C_NAMLENGTH
kast_size=.-kast_code
qkast_end:
        .end
