MACALLSTR@vax1.physics.oxford.ac.UK (07/25/88)
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
.Endsimon@sirius.ua.oz (Simon Hackett) (08/04/88)
From article <8807251321.AA16096@ucbvax.berkeley.edu>, by MACALLSTR@vax1.physics.oxford.ac.UK: > 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 don't need to. VMS V5.0 makes the information easily available; Just use $GETDVI with an item code of TT_ACCPORNAM . Either the system service call direct or F$GETDVI("TERMINAL_ID","TT_ACCPORNAM") The manual entry on this item code (Set P, Volume 4B, Page SYS-215) is: ---------------------- When you specify DVI$_TT_ACCPORNAM, $GETDVI returns the name of the remote access port associated with a channel number, or a physical or virtual terminal device number. If you specify a device which is not a remote terminal, or a remote type that does not support this feature, $GETDVI returns a null string. The $GETDVI service returns the name as server_name/port_name The names are separated by the slash (/) character. If the remote system is an X.29 (VAX PSI) terminal, the name is returned as network.remote_DTE. When writing applications, you should use the string returned by DVI$_ACCPORNAM (sic), instead of the physical device name, to identify remote terminals. ------------------------ {-------------------------------------------------------------------------} { Simon Hackett, Systems Group, University of Adelaide, South Australia } { simon@sirius.ua.oz[.au] } {-------------------------------------------------------------------------}