x$$$dt=0
evax=0
        .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
; axp version...somewhat hacked over
;
        .library "sys$library:lib"
        .link   "sys$system:sys.stb"/selective_search
        $IPLDEF
	$ucbdef
        $ACBDEF
        $DYNDEF
	$DDTDEF				; DEFINE DISPATCH TBL...
	.if df,step2
	ddt$l_fdt=ddt$ps_fdt_2
	.endc
        $PCBDEF
        $PRIDEF
	$IRPDEF
        $PSLDEF
        $SSDEF
        $LNMSTRDEF
	.if	df,step2
	$fdt_contextdef
	$fdtargdef
	$fdtdef
	.endc
	$sbdef	; system blk offsets
	$psldef
	$prdef
	$acldef
	$rsndef				;define resource numbers
	$acedef
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$pcbdef
	.if	df,pcb$m_nounshelve
; If we allow the PCB flags used to control HSM to control this instead
; condition on pcbmsk$$ defined.
pcbmsk$$=0
	.endc
        .iif ndf, PCB$M_NOUNSHELVE, PCB$M_NOUNSHELVE=^x80000
        .iif ndf, PCB$M_SHELVING_RESERVED,PCB$M_SHELVING_RESERVED=^x100000
        .iif ndf, PCB$V_NOUNSHELVE,PCB$V_NOUNSHELVE=19
        .iif ndf, PCB$V_SHELVING_RESERVED,PCB$V_SHELVING_RESERVED=20
	$statedef
	$jibdef
	$acbdef
	$vcbdef
	$arbdef
	$wcbdef
	$ccbdef
	$fcbdef
	$phddef
        $RABDEF                         ; RAB structure defs
        $RMSDEF                         ; RMS constants
; defs for acl hacking
	$fibdef
	$ipldef
	$atrdef
	.if	df,pcb$ar_natural_psb_def
; Allow mods of PSB based privs etc. if it exists.
;	$ktbdef
	$psbdef
	.endc
;
	$DEFINI	UCB			;START OF UCB DEFINITIONS
;.=UCB$W_BCR+2				;BEGIN DEFINITIONS AT END OF UCB
.=UCB$K_LCL_DISK_LENGTH	;v4 def end of ucb
; USE THESE FIELDS TO HOLD OUR LOCAL DATA FOR VIRT DISK.
; Add our stuff at the end to ensure we don't mess some fields up that some
; areas of VMS may want.
; Leave thisfield first so we can know all diskswill have it at the
; same offset.
;
;
$def	ucb$l_hucbs	.blkl	1	;host ucb table
;
; Add other fields here if desired.
;
$def	ucb$l_exdmn	.blkl	1	;extend dmn pid
$def	ucb$l_exmbx	.blkl	1	;extend dmn mbx ucb
$def	ucb$l_deldmn	.blkl	1	;delete daemon pid
$def	ucb$l_delmbx	.blkl	1	;delete dmn mailbox ucb
;
;
$def	ucb$l_ctlflgs	.blkl	1		;flags to control modes
;
;
$def	ucb$l_prcvec	.blkl	1		;process local data tbl
$def	ucb$l_daemon	.blkl	1		;daemon pid for open daemon
$def	ucb$l_mbxucb	.blkl	1		;mailbox for input to daemon
$def	ucb$l_keycry	.blkl	2		;ucb resident "key" for ACEs
						;use as part of authenticator
						;for security-relevant fcns.
		;auth=f(file id, key, priv-info), match ace and computed
		;auth tag.
$def	ucb$l_cbtctr	.blkl	1		;how many extents
$def	ucb$l_cbtini	.blkl	1		;init for counter
; preceding 2 fields allow specifying of contig-best-try extents
; on every Nth extend, not every one. This should still help keep
; file extensions from preferentially picking up chaff
$def	ucb$JTcontfil	.blkb	80
$def	ucb$l_asten	.blkl	1		;ast enable mask store
;
$DEF	ucb$l_minxt	.blkl	1		;min. extent
$def	ucb$l_maxxt	.blkl	1		;max extent
$def	ucb$l_frac	.blkl	1		;fraction to extend by
$def	ucb$l_slop	.blkl	1		;slop blocks to leave free
; DDT intercept fields
; following must be contiguous.
$def    ucb$s_ppdbgn            ;add any more prepended stuff after this
$def    ucb$l_uniqid    .blkl   1       ;driver-unique ID, gets filled in
                                        ; by DPT address for easy following
                                        ; by SDA
$def    ucb$l_intcddt   .blkl   1       ; Our interceptor's DDT address if
                                        ; we are intercepted
$def    ucb$l_prevddt   .blkl   1       ; previous DDT address
$def    ucb$l_icsign    .blkl   1       ; unique pattern that identifies
                                        ; this as a DDT intercept block
; NOTE: Jon Pinkley suggests that the DDT size should be encoded in part of this
; unique ID so that incompatible future versions will be guarded against.
$DEF    UCB$L_ICPFGS    .BLKL   2       ; Flags. Reserve 2 longs so we need
                                        ; not mess with this later.
        $VIELD UCB,0,<-
                <FI8OK,,M>,-            ; 1 if this intercept and all
                        >               ; below understand finipl8.
$def    ucb$l_usr8      .blkl   8
$def    ucb$s_ppdend
$def    ucb$a_vicddt    .blkb   ddt$k_length
                                        ; space for victim's DDT
			.blkl	4	;safety
$def	ucb$l_backlk	.blkl	1	;backlink to victim ucb
; Make the "unique magic number" depend on the DDT length, and on the
; length of the prepended material. If anything new is added, be sure that
; this magic number value changes.
magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
	.iif ndf,f.nsiz,f.nsiz=2048
	.iif	ndf,f.nums,f.nums=16
	.iif	ndf,f.nsiz,f.nsiz=2048
ucb$l_fnums:	.blkw	f.nums	;store for file numbers to inspect whether
				;an ACE is there or not.
$DEF	UCB$L_JT_HOST_DESCR	.BLKL	2	;host dvc desc.
;
; Store copy of victim FDT table here for step 2 Alpha driver.
; assumes FDT table is 64+2 longs long (+ 2 more longs if 64bit)
	.if	df,irp$q_qio_p1
$def	ucb$l_myfdt	.blkl	<<FDT$K_LENGTH/4>+4>	;user FDT tbl copy + slop for safety
	.iff
$def	ucb$l_myfdt	.blkl	70	;user FDT tbl copy + slop for safety
	.endc
$def	ucb$l_oldfdt	.blkl	1	;fdt tbl of prior fdt chain
$def	ucb$l_vict	.blkl	1	;victim ucb, for unmung check
$def	ucb$l_mungd	.blkl	1	;munged flag, 1 if numg'd
$def	ucb$l_exempt	.blkl	4	;exempt PIDs
$def	ucb$l_exedel	.blkl	4	;pids exempt from delete checks only
$def	ucb$l_ktrln	.blkl	1
$def	ucb$l_k2tnm	.blkl	1
	.if	df,msetrp
; mousetrap trace cells
$def	mtp$fmt		.blkl	1	;mousetrap get into format 
$def	mtp$irp		.blkl	1
$def	mtp$ldt		.blkl	1
$def	mtp$trace	.blkl	1
$def	mtp$ccb		.blkl	1
$def	mtp$chan	.blkl	1
$def	mtp$ior0	.blkl	1
$def	mtp$r1		.blkl	2	;findldt tst
$def	mtp$r0		.blkl	1
$def	mtp$trc2	.blkl	1
$def	mtp$trc3	.blkl	2
	.endc
$DEF	UCB$K_JT_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_JT_LEN=.				;LENGTH OF UCB
	$DEFEND	UCB			;END OF UCB DEFINITONS

EFN=17
LNM$C_NAMLENGTH=255
	.macro	zapz	addr,size
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	movc5	#0,addr,#0,size,addr
	popr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	.endm
        .psect  EXTTRNLND quad,pic,con,lcl,noshr,noexe,wrt
argbase:
pid:    .blkl   1	;0
prcnam: .blkl   1	;4
pcb:    .blkl   1	;8
adr:    .blkl   1	;12
retcod: .blkl   1	;16
lnmstrlen:		;20
        .blkl   1
tblstrlen:		;24
        .blkl   1
lnmstr: .blkb   32	;28
tblstr: .blkb   32	;60
stat:   .blkl   1	;64
        .blkl   1	;68
        .blkb   LNM$C_NAMLENGTH	;72
	.blkb	1	;make it even
	.blkl	4	;328
; lnmx$t_xlation = 4
outbuf: .blkb   LNMX$T_XLATION+LNM$C_NAMLENGTH	;344
	.blkb	1	;make it even
	.blkl	20
	.align long
arglen=.-argbase
jtadr:	.long	0	;jt ucb
jtrtn:	.long	0	;our routine
jtdesc:	.ascid	/JTA0:/	;device name to search for
	.align long
jiosb:	.blkl	2
jibitm:
	.word	4
	.word	jpi$_pid
	.address	thispid
	.address	junk
	.long	0,0,0
thispid:	.long	0	;tgt epid
junk:	.long	0
tgtipid:	.long	0
        .psect  EXTTRNLNM quad,pic,con,lcl,noshr,exe,wrt
;
;  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
        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
	movab	pid,r0
	movab	prcnam,r1
	movab	jibitm,r2
	$getjpiw_s efn=#7,pidadr=(r0),prcnam=(r1),itmlst=(r2),iosb=jiosb
;
; convert thispid (epid) to an ipid in tgtipid somewhere
;
        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)		; length of translation
        movl    20(ap),r1		; address of translation buffer
        movc3   stat+4,stat+8,@4(r1)
        movl    #SS$_NORMAL,r0
;
100$:
	movl	r0,r8
        pushab  qkast_end
        pushab  qkast
        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
        .entry  qkast,^m<r2,r3,r4,r5,r11>
; get in here in kernel mode, ipl at most at ASTDEL
sf$a_handler=0
        movab   G^EXE$SIGTORET,SF$A_HANDLER(fp) ; set exception handler
        movl    r4,pcb                  ; save pcb of caller process
        movab   stat,adr                ; save address
	.if	ndf,evax
        pushl   prcnam
        pushab  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
	.iff
;        pushl   prcnam
;        pushl   pid
;	calls	#2,calnampid		; call via one lower routine
;        blbs    r0,100$
;        brw     err
;100$:   UNLOCK  SCHED,newipl=#IPL$_ASTDEL
	.endc
	movl	thispid,r0	;epid
	beql	1300$
	jsb	g^exe$cvt_epid_to_ipid
; ipid returns in r0
	tstl	r0
	bleq	1300$
        cmpl    r0,G^SCH$GL_SWPPID      ; test if swapper
        bneq    200$
        movl    #SS$_NONEXPR,r0
        brw     err
200$:
	movl	r0,r11			; save target pid
	beql	1300$
	.if	ndf,evax
	addl3   #kast_size,#ACB$K_LENGTH,r1
	.iff
	movl	#<acb$k_length+arglen>,r1
	.endc
        jsb     G^EXE$ALONPAGVAR       ; allocate ACB
        blbs    r0,300$
1300$:  brw     err
300$:
	zapz	(r2),r1			; zero the ACB grabbed first
	.iif df,x$$$dt,jsb g^ini$brk ;***************** debug ********
        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$m_nodelete>,ACB$B_RMOD(r2)
	movl	r11,acb$l_pid(r2)	;get target pid
	bleq	1300$
;        movl    PCB$L_PID(r4),ACB$L_PID(r2)
	.if	ndf,evax
	movab	argbase,acb$l_astprm(r2)	;save our data area
	.iff
	clrl	acb$l_astprm(r2)		;initially clr data addr
	.endc
	.if	ndf,evax
        movab   ACB$K_LENGTH(r2),ACB$L_KAST(r2)
	.iff
	pushl	r2
	pushl	r4
	movl	g^ctl$gl_pcb,r4
	jsb	g^sch$iolockw
	movab	jtdesc,r1
	clrl	jtadr
	JSB     G^IOC$SEARCHDEV	;find jta0: ucb (r1 gets addr)
	blbc	r0,305$
	movl	r1,jtadr	;ucb of jta0:
	movl	ucb$l_ktrln(r1),jtrtn	;save our addr
305$:
	jsb	g^sch$iounlock
	popl	r4
	popl	r2
	tstl	jtrtn		;did we get the routine?
	bgeq	306$		;if not negative it isn't here!
	movl	jtrtn,acb$l_kast(r2)	;use ast code inside jtdriver
	brb	307$
306$:	brw	err
307$:
	.endc
	pushr	#^m<r0,r1,r2,r3,r4,r5>
; note here we move DATA, not code.
	movab	argbase,r3
	movab	acb$k_length(r2),r4
        movc3	#arglen,(r3),(r4) ; move AST data
	popr	#^m<r0,r1,r2,r3,r4,r5>
	movab	acb$k_length(r2),acb$l_astprm(r2) ;set param to point at it
; thus the data areas the ast code will use will be in acb
        pushr   #^m<r2,r4>
	.iif df,x$$$dt,jsb g^ini$brk ;***************** debug ********
        movl    #EFN,r3
        movl    pcb,r4
        jsb     G^SCH$CLREF             ; clear event-flag
        popr    #^m<r2,r4>
	.iif df,x$$$dt,jsb g^ini$brk ;***************** debug ********
        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
; AST CODE, loaded with our program & called there to grab the user's logical
kast_code: .iif df,evax, .jsb_entry
        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)
	.if	ndf,evax
        addl2   #kast_code_size,ACB$L_KAST(r5)
	.iff
	movab	kast_code_2,acb$l_kast(r5)
	.endc
        movb    #ACB$M_KAST!PSL$C_KERNEL,ACB$B_RMOD(r5)
        movl    #0,r2
        jsb     G^SCH$QAST              ; requeue AST
	rsb
;
kast_code_size=.-kast_code
kast_code_2: .iif df,evax, .jsb_entry
        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
        jsb     G^EXE$DEANONPAGED       ; deallocate ACB and disappear
	rsb
;
kast_size=.-kast_code
qkast_end: .jsb_entry
	rsb
        .end
