From:	CSBVAX::MRGATE!info-vax-RELAY@KL.SRI.COM@SMTP  2-AUG-1988 22:15
To:	ARISIA::EVERHART
Subj:		Server/port/session information for LAT terminals.


Received: from NSS.Cs.Ucl.AC.UK by KL.SRI.COM with TCP; Tue, 19 Jul 88 08:58:40 PDT
Received: from vax1.physics.oxford.ac.uk by NSS.Cs.Ucl.AC.UK 
           via Janet with NIFTP  id aa04644; 19 Jul 88 15:59 BST
Date:		19-JUL-1988 16:26:23 GMT +01:00
From:		MACALLSTR%vax1.physics.oxford.ac.uk@NSS.Cs.Ucl.AC.UK
To:		info-vax <@NSS.Cs.Ucl.AC.UK:info-vax@kl.sri.com>
Subject:	Server/port/session information for LAT terminals.
Sender:         John_Macallister <MACALLSTR%vax1.physics.oxford.ac.uk@NSS.Cs.Ucl.AC.UK>
From:           John_Macallister <MACALLSTR%vax1.physics.oxford.ac.uk@NSS.Cs.Ucl.AC.UK>
X-Info:         Nuclear Physics Lab,Keble Rd,Oxford OX1 3RH. Phone+44-865-273388
X-Info2:        Fax +44-865-273418. Telex 83295 NUCLOX G.

For anyone wishing to obtain the session/server/port information for any
 LAT terminal here is a subroutine ( originally from a DECUS library
 tape I believe ) which works with VMS 4.7 and earlier : I don't have
 VMS 5.0 to try it out on that yet. You may find it useful to use this routine
 for checking login sources during the login sequence but be aware that
 ANYONE who has read the DECserver manuals and with physical access to a 
 DECserver can change all its characteristics viz. server name and port name!
 But the routine is still useful for monitoring terminal server use and, if
 you run a really tight ship with DECservers locked away in safes, it could
 provide an extra level of security.
Here's the routine.
----------------------------------------

        .Title          LAT_Info - Get information about a LAT terminal
        .Ident          /V01.000/
        .Enable         SUP
        .Default        Displacement,Word
        .Subtitle       Introduction
 
;+
;
; ----- LAT_Info:  Get information about a LAT terminal
;
;
; Facility:
;
;       VAX/VMS system programming
;
; Abstract:
;
;       This module provides a routine which can be called from any
;       VAX native  language to obtain information about a specific
;       LAT terminal.
;
; Environment:
;
;       VAX/VMS native mode, VMS V4.2 or later, LATPlus V01.012, CMKRNL
;       privilege.
;
;
;
; Version:      V01.000
; Date:         19-Dec-1986
;
; Gerard K. Newman
; San Diego Supercomputer Center
; GA Technologies
; P.O. Box 85608
; San Diego, CA  92138
; 619.534.5076
;
; GKN@SDSC.ARPA, GKN@SDSC.BITNET
;
; Modifications:
;
;       BMW001 -- (5-jan-1987)  Check for non-zero physical UCB before
;                               following chain of indirection.
;       BMW002 -- (5-jan-1987)  Use intermediate buffering to avoid some
;                               sticky problems: (1) allow other types of
;                               descriptors by copying info from local buffers
;                               to user buffers (in user mode).  (2) Modify
;                               internal calling mechanism to include length
;                               arguments, thus avoid modifying the descriptor
;                               which was only probed for read access.
;
;
;-
 
        .Page
        .Subtitle       Local definitions
 
        .Library        "SYS$LIBRARY:LIB"       ;Get special macros from here
        .Link           "SYS$SYSTEM:SYS.STB"/Selective_Search   ;Ease the link
;                                                               ;process a bit
 
        .NoCross        ;Save a tree
 
        $DCDEF          ;Device class & type definitions
        $DDBDEF         ;Device data block offsets
        $DSCDEF         ;Descriptor symbols (BMW002)
        $SSDEF          ;System service codes
        $TTYUCBDEF      ;Terminal UCB offsets
        $UCBDEF         ;UCB offsets
 
        .Cross          ;Turn CREF back on
 
 
; Local definitions
 
; Constants that are likely to change in a future release of VMS that are not
; defined in SYS.STB  or in a macro anywhere.  These values come from looking
; at the running system with SDA.
 
; Offset in an LT UCB to the length of the port name, which is a counted
; string.  Immediately following the port name is another counted string
; which is the LAT node name.
 
UCB$B_LT_PORT   =       ^X134   ;Offset to the port name length
UCB$B_LT_SESS   =       ^X195   ;Offset to the session number
 
        .Page
        .Subtitle       LAT_INFO - Get information about a LAT terminal
 
;+
;
; ----- LAT_INFO:  Get information about a LAT terminal
;
;
; This routine can be called by any VAX native language to obtain the server
; name, port name  and session number of a  LAT connection given a LT device
; name.  The calling program must have  CMKRNL privilege and  must be linked
; with SYS.STB.
;
; Caveats:
;
;    Will only work with fixed (non-dynamic) string descriptors.
;    (BMW002) modified to work with any type string descriptor.
;
; Call sequence:
;
;    status.wlv = LAT_INFO (terminal.rt.dx, session.wlr,
;                               server.wt.dx, port.wt.dx)
;
; Inputs:
;
;    4(AP)      - Address of a descriptor of the LT device name.
;    8(AP)      - Address of a longword to return the session number in.
;    12(AP)     - Address of a descriptor to return the server name.
;    16(AP)     - Address of a descriptor to return the server port name.
;
; Outputs:
;
;    R0 - SS$_NOPRIV:           No CMKRNL privilege.
;       - SS$_ACCVIO:           One of the arguments is not accessible.
;       - SS$_NOSUCHDEV:        The specified LT device can't be found.
;       - SS$_IVDEVNAM:         The specified device isn't a LAT terminal.
;       - SS$_NORMAL:           Success.
;       (BMW002) other status codes may be returned by the RTL
;
;   (BMW002)
;
;       Internally, the routine calls a kernel mode routine which does
;       the actual lookup.  This k-mode routine can only handle fixed
;       length string descriptors for the two output parameters, and
;       will only accept fixed length or dynamic string descriptors for
;       the terminal name (which is read-only).  In order to implement
;       other string types, the routine provides intermediate buffering
;       of the three string parameters.  Two additional parameters are
;       passed to the kernel mode routine.  These are used to receive
;       the actual lengths of the server name and port name.  In essence,
;       the internal k-mode routine is called with the following argument
;       list:
;
;               status = krtn( terminal.rt.dx, session.wlr,
;                               server.wt.dx, port.wt.dx,
;                               slength.wwr, plength.wwr )
;
;               4(AP)   - address of dynamic string descriptor containing
;                         the terminal name (read-only).
;               8(AP)   - address of a longword to receive the session
;                         number (copied directly from the user's
;                         argument list).
;               12(AP)  - address of a fixed length string descriptor to
;                         receive the server name.
;               16(AP)  - address of a fixed length string descriptor to
;                         receive the port name.
;               20(AP)  - address of a word to receive the length of the
;                         server name.
;               24(AP)  - address of a word to receive the length of the
;                         port name.
;
;       (BMW002)
;-
 
;+
;       (BMW002) Add local data Psect
;-
        .Psect          LAT_DATA,REL,CON,NOEXE,LCL,NOPIC,WRT,NOSHR,QUAD
 
Server_Name:
        .blkb           128             ; reserve 128 characters for name
Server_Length=.-Server_Name
 
Port_Name:
        .blkb           128             ; reserve 128 characters for name
Port_Length=.-Port_Name
 
        .align          quad            ; start descriptors on quad boundary
;                                       ; (not absolutely necessary)
 
; Set up the descriptors.  We will use a dynamic string for the terminal
; name, since it is treated as read-only by the kernel mode routine
; (i.e. additional space will not need to be allocated once in kernel
; mode).  The server and port names are set up as statically allocated
; strings so that the kernel mode routine may precheck the buffers for
; write accessibility.  We could use dynamic strings for them also, but
; we would have to call LIB$SGET_DD to get space before calling the
; kernel mode routine (the k-mode routine is incapable of allocating
; dynamic string space itself).
 
Terminal_Desc:
        .word           0               ; Empty Dynamic string
        .byte           DSC$K_DTYPE_T   ; character-coded text
        .byte           DSC$K_CLASS_D   ; Dynamic string descriptor
        .long           0               ; Empty Dynamic string
 
Server_Desc:
        .word           Server_Length   ; length of buffer
        .byte           DSC$K_DTYPE_T   ; character-coded text
        .byte           DSC$K_CLASS_S   ; scalar string descriptor
        .address        Server_Name     ; buffer address
 
Port_Desc:
        .word           Port_Length
        .byte           DSC$K_DTYPE_T
        .byte           DSC$K_CLASS_S
        .address        Port_Name
 
Arglist:
        .blkl           7               ; intermediate arglist
 
SName_Length:
        .blkw           1               ; space for length of server name
 
PName_Length:
        .blkw           1               ; space for length of port name
 
;+
;       (BMW002) End of added Psect
;-
 
        .Psect          LAT_INFO,EXE,RD,NOWRT,PIC,SHR,PAGE
 
        .Entry          LAT_INFO,^M<R2,R3,R4,R5,R6>     ;Entry here
 
        MOVL            #SS$_INSFARG,R0 ; Assume things are bad (BMW002)
        CMPB            #4,(AP)         ; Check number of arguments (BMW002)
        BNEQ            5$              ; Not enough arguments (BMW002)
        MOVL            4(AP),R0        ; Point R0 to input terminal name
        MOVAL           Terminal_Desc,R1 ;Point R1 to output descriptor
;
;       Note that the call to LIB$SCOPY_DXDX to copy the string has the
;       side effect (since the output string is dynamic) of allocating
;       space to the output string.
;
        JSB             G^LIB$SCOPY_DXDX6 ;Copy string
        BLBC            R0,5$           ; Exit on error
        MOVL            #SS$_ACCVIO,R0  ; Assume bad things
        MOVL            #6,ARGLIST      ; Init count field of arglist (BMW002)
        MOVAL           Terminal_Desc,ARGLIST+4 ; move terminal name (BMW002)
        MOVL            8(AP),ARGLIST+8 ; move session param directly (BMW002)
        BEQL            5$              ; exit if it was omitted (BMW002)
        MOVAL           Server_Desc,ARGLIST+12 ; (BMW002)
        MOVAL           Port_Desc,ARGLIST+16 ; (BMW002)
        MOVAL           SName_Length,ARGLIST+20 ; (BMW002)
        MOVAL           PName_Length,ARGLIST+24 ; (BMW002)
        BRB             6$              ; Some of the above branches are
;                                       ; out of range. (BMW002)
5$:     RET                             ; so we need 5$ to move the exit closer
 
6$:
        $CMKRNL_S       ROUTIN=B^20$,-  ;Do this
                        ARGLST=ARGLIST  ; in kernel mode (BMW002)
 
        BLBC            R0,10$          ; On error, return (BMW002)
 
;+  (BMW002)
;
;       We now use the RTL routines to copy from our intermediate buffers
;       (set up as static strings) into the user's buffers.  This is done
;       in normal user mode, so dynamic strings can be used without
;       problems.
;
;-
 
        MOVZWL          SName_Length,R0         ; Setup for string copy
        MOVAL           Server_Name,R1
        MOVL            12(AP),R2
        JSB             G^LIB$SCOPY_R_DX6       ; Do copy
        BLBC            R0,10$                  ; On error, return
        PUSHL           R0                      ; Else, save status
        MOVZWL          PName_Length,R0         ; Setup for string copy
        MOVAL           Port_Name,R1
        MOVL            16(AP),R2
        JSB             G^LIB$SCOPY_R_DX6       ; Do copy
        POPL            R1                      ; Get previous status into R1
        BLBC            R0,10$                  ; Return if error on 2nd copy
        CMPL            #SS$_NORMAL,R1          ; If 1st was a total success,
        BEQL            10$                     ; Return status from 2nd copy
        CMPL            #SS$_NORMAL,R0          ; If 2nd copy was not ok,
        BNEQ            10$                     ; Return it's status
        MOVL            R1,R0                   ; 2nd was ok, return 1st status
 
;+ (BMW002)
;
;       End of string copy
;-
 
10$:    RET             ;Done, status in R0
 
; Here in kernel mode to do all of the actual work.
 
20$:    .Word   ^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>     ;Here in kernel mode
;                                                       ;to get some info
 
; First, check to see if we can read the argument list.
 
        MOVL    #SS$_ACCVIO,R0          ;Presume we can't
        IFNORD  #<7*4>,(AP),10$         ;Probe the argument list (BMW002)
 
; Check the number of arguments
 
        MOVL    #SS$_INSFARG,R0 ;Presume we have too few arguments
        CMPB    #6,(AP)         ;Do we have enough arguments?
        BNEQ    10$             ;If NEQ no, it's wrong somehow
 
; Check to see if we can write the session number.
 
        MOVL    #SS$_ACCVIO,R0  ;Presume we can't
        IFNOWRT #4,@8(AP),10$   ;Probe the output session number
 
; See if we can read the device name descriptor.
 
        MOVL    4(AP),R1        ;Address the LT device name descriptor
        JSB     G^EXE$PROBER_DSC        ;Probe the descriptor
        BLBC    R0,10$          ;Sigh.
        MOVQ    R1,-(SP)        ;Save a safe copy of the probed descriptor
        MOVL    SP,R11          ;Remember where it is
        CLRW    2(R11)          ;Never mind the type and class info
 
; See if we have write access to the two output descriptors.
 
        MOVL    12(AP),R1       ;Address the server name output descriptor
        JSB     G^EXE$PROBEW_DSC        ;Probe the descriptor
        BLBC    R0,10$          ;Sigh.
        MOVQ    R1,-(SP)        ;Stash a safe copy of the descriptor
        MOVL    SP,R10          ;Remember where I put it
        CLRW    2(R10)          ;Never mind the type and class info
        MOVL    16(AP),R1       ;Address the port name output descriptor
        JSB     G^EXE$PROBEW_DSC        ;Probe the descriptor
        BLBC    R0,10$          ;Sigh.
        MOVQ    R1,-(SP)        ;Stash a safe copy of said descriptor
        MOVL    SP,R9           ;Remember where it is
        CLRW    2(R9)           ;Never mind the type and class info
 
; Probe the Server length for write access (BMW002)
 
        IFNOWRT #2,@20(AP),10$  ; (BMW002)
 
; Probe the Port length for write access (BMW002)
 
        IFNOWRT #2,@24(AP),10$  ; (BMW002)
 
; Ok.  Now go hunt down the device the user told us was a LAT terminal
; and see if it really is.
 
        MOVL    G^SCH$GL_CURPCB,R4      ;Get my PCB address
        JSB     G^SCH$IOLOCKR   ;Lock the I/O database mutex
        MOVL    R11,R1          ;Address the device name descriptor
        JSB     G^IOC$SEARCHDEV ;Go search for the device.
        BLBC    R0,30$          ;We lose.
 
; Now check to see if it's even a terminal, and if it is see if it's a LAT
; terminal.  Remember to chain  to the physical UCB  first in case this is
; a disconnectable terminal.
 
        MOVL    #SS$_IVDEVNAM,R0                ;Presume it isn't a terminal
        CMPW    #UCB$C_TT_LENGTH,UCB$W_SIZE(R1) ;Check length of UCB (BMW001)
        BGTR    30$                             ;UCB too short for term (BMW001)
        TSTL    UCB$L_TL_PHYUCB(R1)             ;Check for phys UCB (BMW001)
        BEQL    25$                             ;no phys UCB, skip next (BMW001)
        MOVL    UCB$L_TL_PHYUCB(R1),R1          ;Get to the "real" UCB
25$:    CMPB    #DC$_TERM,UCB$B_DEVCLASS(R1)    ;Is it a terminal? (BMW001)
        BNEQ    30$                             ;If NEQ no.
        MOVL    UCB$L_DDB(R1),R2                ;Find the DDB
        CMPW    #^A/LT/,DDB$T_NAME+1(R2)        ;Is this a LAT terminal?
        BNEQ    30$                             ;If NEQ no
 
; It's a LAT terminal all right.  Obtain the server name, port name and
; session number.
 
        MOVZBL  UCB$B_LT_SESS(R1),@8(AP)        ;Stash the session number
        MOVAB   UCB$B_LT_PORT(R1),R1    ;Address the port name
        MOVL    R9,R6                   ;Here's the output descriptor address
        BSBB    MOVE_ASCIC              ;Move the port name
        MOVW    (R6),@24(AP)            ;Return the length (BMW002)
        MOVL    R10,R6                  ;R1 now points at the server name
        BSBB    MOVE_ASCIC              ;So go move it, too
        MOVW    (R6),@20(AP)            ;Return the length (BMW002)
        MOVL    #SS$_NORMAL,R0          ;Success!
 
30$:    PUSHL   R0                      ;Save the return status
        MOVL    G^SCH$GL_CURPCB,R4      ;Get my PCB address again
        JSB     G^SCH$IOUNLOCK          ;Unlock the I/O database mutex
        SETIPL  #0                      ;Drop back down from IPL$_ASTDEL
        POPL    R0                      ;Restore the return status
        RET                             ;Back to user mode
 
; Short subroutine to move a .Ascic string to a place described by a
; descriptor.  Forms a  proper descriptor of the result, and handles
; short buffers, etc.
;
; Inputs:
;
;    R1    - Address of the .Ascic string
;    R6    - Address of the output descriptor
;
; Outputs:
;
;    R1    - Address of one byte past the end of the .Ascic string
;    R0-R5    - Smashed
 
MOVE_ASCIC:                     ;Here to move a .Ascic string
 
        MOVZBL  (R1)+,R0        ;Grab the string length
        CMPW    (R6),R0         ;Check the string length
        BGEQU   10$             ;If GEQU then we can use it
        MOVZWL  (R6),R0         ;Else only copy what will fit
 
10$:    MOVW    R0,(R6)         ;Stash the length
        MOVC3   R0,(R1),@4(R6)  ;Copy the string
        RSB                     ;Done
 
        .End


