From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-FEB-1989 15:05
To:	MRGATE::"ARISIA::EVERHART"
Subj:	setuser 3 of 3


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Sat, 25 FEB 89 01:31:13 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Sat, 25 Feb 89 01:33:11 PST
Received: by ucbvax.Berkeley.EDU (5.61/1.34)
	id AA20801; Sat, 25 Feb 89 01:23:44 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 24 Feb 89 20:45:47 GMT
From: rochester!rit!ultb!awpsys@rutgers.edu  (Andrew W. Potter)
Organization: Information Systems and Computing @ RIT, Rochester, New York
Subject: setuser 3 of 3
Message-Id: <384@ultb.UUCP>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


+-+-+-+ Beginning of part 3 +-+-+-+
X                beql    error_stop
X;
X                cmpl    r0, #RMS$_NORMAL
X                beql    close_sysuaf
X;
Xerror_stop:     pushl   r0
X                pushal  usekey
X                pushl   #1
X                pushl   #SETUSER_ERRSEARCH
X                calls   #4, g`094lib$stop          ; Signal and stop on error
X;
Xclose_sysuaf:   $close  fab = infab             ; Close UAF
X                blbs    r0, begin_locks
X;
X                pushl   r0
X                pushl   #0
X                pushl   #SETUSER_ERRCLOSUAF
X                calls   #3, g`094lib$stop
X;
X;       lock code and data into working set
X;
Xbegin_locks:    moval   lock_dat_beg, lock_dat_beg
X                moval   end_dat, lock_dat_end
X                $lckpag_s -
X                        inadr = lock_dat_beg
X                blbs    r0, 20$
X;
X                ret                             ; Leave on error
X;
X20$:            moval   kerstuf, lock_code_beg
X                moval   kerstuf_e, lock_code_end
X                $lckpag_s -
X                        inadr = lock_code_beg
X                blbs    r0, 30$
X;
X                ret                             ; Leave on error
X;
X;       Pick up address of just read UAF record (now locked)
X;
X30$:            movl    inrab + rab$l_rbf, r7
X                movl    uaf$l_uic(r7), r8
X                movl    r8, new_uic
X;
X;       go kernel mode
X;
X                $cmkrnl_s change_user           ; Make us the new user
X                blbs    r0, 40$
X;
X                ret
X;
X40$:            $cmkrnl_s change_logs           ; Change logical tables
X                blbs    r0, 50$
X;
X                ret                             ; Leave on error
X;
X;       Allow paging again
X;
X50$:            $ulkpag_s -
X                        inadr = lock_dat_beg    ; Don't care if these fail
X                $ulkpag_s -
X                        inadr = lock_code_beg
X;
X                movzbl  uaf$t_defdev(r7), r6
X                movc3   r6, 1+uaf$t_defdev(r7), defdev  ; Move to descriptor
X                movl    r6, dev_descr
X;
X                movzbl  uaf$t_defdir(r7), r8
X                movc3   r8, 1+uaf$t_defdir(r7), defdir  ; Move to descriptor
X                movl    r8, dir_descr
X;
X                movc3   r6, defdev, def_buf
X                movc3   r8, defdir, (r3)        ; Concat into one string
X                addl3   r6, r8, def_descr
X;
X                $getjpiw_s -                    ; Get all of our process info
X                        itmlst = jpi_item       ; - we need
X;
X                blbs    r0, 10$
X;
X                pushl   r0
X                pushl   #0
X                pushl   #SETUSER_GETJPIERR
X                calls   #3, g`094lib$stop
X;
X10$:            pushl   group
X                pushal  def_descr
X                pushal  dev_descr
X                calls   #3, set_logical         ; Set the proper logicals
X;
X                pushal  user_descr
X                pushal  user_descr
X                pushal  user_descr
V                calls   #3, g`094str$trim          ; Trim current username st
Xring
X;
X                pushal  old_user_descr
X                pushal  old_user_descr
X                pushal  old_user_descr
V                calls   #3, g`094str$trim          ; Trim the old username st
Xring
X;
X                pushal  user_descr              ; Set the process name
X                calls   #1, set_prcnam
X;
X                clrq    -(sp)
X                pushal  def_descr
V                calls   #3, g`094sys$setddir       ; Set the default director
Xy
X;
X                movl    uic, oper_uic
X                movl    pid, oper_pid
V                callg   oper_fao_arg, g`094sys$fao ; Format a message for ope
Xrators
X;
X                pushal  oper_message
X                calls   #1, oprmsg              ; Send the message
X;
X                movl    pid, term_pid
X                movl    uic, term_uic
V                callg   term_fao_arg, g`094sys$fao ; Format a message for the
X terminal
X;
X                pushal  term_message
V                calls   #1, g`094lib$put_output    ; Send a message to the te
Xrminal
X;
X                movl    #SS$_NORMAL, r0
X                ret
X;
X;
X;
X                .psect  kernel_code exe, pic, noshr, nowrt
X;
Xkerstuf:        .entry  change_user, `094m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
X;+
X; Set our IPL to SYNCH so that we can access the system wide databases.
X;-
X`009        LOCK  SCHED
X                movl    ctl$gl_pcb, r11         ; get PCB addr into r11
X                movl    r8, pcb$l_uic(r11)      ; R8 has UIC
X                movl    pcb$l_jib(r11), r10     ; pick up addr of the JIB
X;
X;       Move username and account into JIB and CTL
X;
X                movc3   #12, uaf$t_username(r7), jib$t_username(r10)
X                movc3   #12, uaf$t_username(r7), ctl$t_username
X                movc3   #8, uaf$t_account(r7), jib$t_account(r10)
X                movc3   #8, uaf$t_account(r7), ctl$t_account
X;
X`009        UNLOCK SCHED
X                movl    #1, r0
X                ret
X;
X;
X;
X                .entry  change_logs, `094m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
X;
X                movab   handler, (fp)           ; Establish condition handler
X;+
V; Set our IPL to AST delivery level so that there are no interruptions while
X the
V; translation of the logical name is being carried out.  Then lock the logica
Xl
V; name mutex for reading, and then search for the specified logical name.  Th
Xe
V; internal routine from LNMSUB in the VMS source, LNM$SEARCHLOG, finds a logi
Xcal
X; name and returns the address of the table it is under.  We then move the
X; arguments into the appropriate registers for LNM$SEARCHLOG, and make the
X; call.  When we are done, we lower our IPL back down to zero.
X;-
V                setipl  s`094#ipl$_astdel, -       ; Lower IPL to AST deliver
Xy level
X                        environ=uniprocessor
X                jsb     g`094lnm$lockr             ; Lock tables for reading
X;
V                movb    #1, mutex_flag          ;*Note elevated IPL & mutex h
Xeld
X                movq    lognam, r0              ; Get logical name descriptor
X                movq    table, r2               ; Get table name descriptor
V                bicl    #`094xffff0000, r0         ; Clear the upper bits of
X R0
X                bicl    #`094xffff0000, r2         ; and R2
V                movl    #3, r5                  ; Set R5 to it's required val
Xue
X;+
X; Call to LNM$SEARCHLOG expects the following registers to be set up:
X;
X;       R0 - length of logical name string
X;       R1 - Address of logical name string
X;       R2 - Length of table name string
X;       R3 - Address of table name string
X;       R5 - Search access mode in low byte,
X;            caseless flag in bit 8,
X;            high order word 0.
X; Returns:
X;
X;       R0 low bit clear indicates search failure.
X;               R0 - SS$_NOLOGNAM - No logical name match found.
X;               R1 - Address of logical name block on which search failed
X;
X;       R0 low bit set indictes success with:
X;               R1 - Address of logical name block that contains match
X;
X;       All other registers are preserved
X;-
X;+
X;                       PLEASE TAKE HEED !!!!
X;
X; WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
X;
X; KLUGE   KLUGE   KLUGE   KLUGE   KLUGE   KLUGE   KLUGE   KLUGE   KLUGE
X;
X; WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
X;
X; The following three lines is a MAAAAAJOR kluge!  In VMS V5 and access to
X; system entry points were vectorized.  Some routines were not considered
X; necessary enough to be vectorized.  So, we cannot JSB or CALL those routine
X; not vectoried.  BUT, in order that we can call LNM$SEARCHLOG, which we
X; need in order to get the address of our job table, we have KLUGED around
X; this.
X;
X; Vectors for routines called by JSB are 8 bytes long and look like this:
X;
X;                       JMP     L`094FOO
X;                       .BLKB 2
X;
X; Now, in looking through VMS Microfiche, we noticed that LNM$SEARCH_ONE
X; begins right after the end of LNM$SEARCHLOG.  What we do is use the
X; universal symbol LNM$SEARCH_ONE to get the address of the JMP instruction
X; above.  The JMP instruction is two bytes long so we add 2 to the symbol
X; LNM$SEARCH_ONE to get to the address JMP jumps to.  That address is the
X; actual virtual address of the routine LNM$SEARCH_ONE.  Subtracting the
X; length of LNM$SEARCHLOG from that address gets the start of LNM$SEARCHLOG.
X; We found the length of LNM$SEARCHLOG by looking through the VMS Microfiche.
X;
X;
X;-
V                movl    g`094LNM$SEARCH_ONE+2, r11 ; Address after jump instr
Xuction
V                subl2   #`094X93, r11              ; Subtract length LNM$SEAR
XCHLOG
V; *************           `094`094`094 **************************************
X***********
X;                         `094`094`094
X;        Check this value at EVERY release of VMS
X;
X;
V                jsb     (R11)                   ; KKKLUGE!! goto LNM$SEARCHLO
XG
X
X                movl    r0, r10                 ; Save the search status
X                blbc    r0, 20$                 ; Branch if no name found
X;
X                movl    lnmb$l_table(r1), r1    ; Get address of table header
V                movl    lnmth$l_orb(r1), r1     ; Get address of object right
Xs block
V                movl    r8, orb$l_owner(r1)     ; Set the new owner of the ta
Xble
X;
V20$:            jsb     g`094lnm$unlock            ; Release lock on logical
X mutex
X;
X                setipl  #0, -                   ; Drop our IPL to zero
X                        environ=uniprocessor
X
X                clrl    mutex_flag              ; Clear the mutex-held flag
X                movl    r10, r0                 ; Move return status back
X;
X                ret
X;
X;+
X; This is the condition handler in case anything happens during kernel mode
X; execution.
X;-
X                .entry  handler, `094m<>
X;
X                tstl    mutex_flag              ; Mutex held ?
X                beql    10$                     ; Branch if nope...
X                jsb     g`094lnm$unlock            ; Release our mutex
X                setipl  #0                      ; Drop our ipl to zero
X;
X10$:            $exit_s                         ; Cause process to exit
Xkerstuf_e:
X;
X                .end    set_user
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 3 +-+-+-+-+-
-- 
Andrew W. Potter                         Email: awpsys@ritvax.BITNET
Systems Programmer                          awp8101%ritcv@cs.rit.edu
Information Systems and Computing
Rochester Institute of Technology, Rochester NY, 14623 (716) 475-6994

