From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-FEB-1989 14:25
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Access Port Names


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri, 24 FEB 89 18:31:47 PDT
Received: from TopGun.Sdsc.Edu by KL.SRI.COM with TCP; Fri, 24 Feb 89 18:26:29 PST
Date:    Sat, 25 Feb 89 02:25:29 GMT
From:     gkn@TopGun.Sdsc.Edu (Gerard K. Newman)
Message-Id: <890225022529.29a00119@TopGun.Sdsc.Edu>
Subject: Access Port Names
To:       info-vax@kl.sri.com
X-ST-Vmsmail-To: ST%"info-vax@kl.sri.com"

Hi:

Here's a little toy I wrote yesterday which lets a suitably privileged
(CMKRNL) user manipulate the Access Port Name (DVI$_TT_ACCPORNAM)
field for terminal devices, e.g.

$ Run ACCPORNAM
ACCP> Show TXA0
%ACCP-I-ACCP, Access port name of _TXA0: is set to Operator's room
ACCP> Set TXA0 On the moon
ACCP> Show TXA0
%ACCP-I-ACCP, Access port name of _TXA0: is set to On the moon
ACCP> Exit
$ 

VMS V5.x only;  use it carefully (it doesn't crash my systems, but ...).
It comes in two parts.

Cheers,

gkn
----------------------------------------
Internet: GKN@SDS.SDSC.EDU
Bitnet:   GKN@SDSC
Span:     SDSC::GKN (27.1)
MFEnet:   GKN@SDS
USPS:     Gerard K. Newman
          San Diego Supercomputer Center
          P.O. Box 85608
          San Diego, CA 92138-5608
Phone:    619.534.5076

$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user GKN
$! on 24-FEB-1989 19:37:39.30.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 2 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 3 files:
$!        ACCPORNAM.MAR
$!        ACCPORNAM_MSG.MSG
$!        MAKE_ACCPORNAM.COM
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START: 
$ FILE_IS = "ACCPORNAM.MAR"
$ CHECKSUM_IS = 1142977795
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.Title`009ACCPORNAM`009- Set the Access Port Name for terminals
X`009.Ident`009/V01.000/
X`009.Enable`009SUP
X`009.Default Displacement,Word
X`009.Subtitle`009Introduction
X
X;+
X;
X; ----- ACCPORNAM:  Set the Access Port Name for terminals
X;
X;
X; Facility:
X;
X;`009VAX/VMS system management
X;
X; Abstract:
X;
X;`009This module allows a suitably privileged user to set the Access
X;`009Port Name (ACCPORNAM) for hard-wired terminals.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V5.0 or later, CMKRNL privilege.
X;
X;
X;
X; Version:`009V01.000
X; Date:`009`00924-Feb-1989
X;
X; Copyright `169 1989  San Diego Supercomputer Center
X;
X; Gerard K. Newman`00924-Feb-1989
X; San Diego Supercomputer Center
X; General Atomics
X; P.O. Box 85608
X; San Diego, CA  92138-5608
X; 619.534.5076
X;
X; Internet:`009GKN@SDS.SDSC.EDU
X; BITNET:`009GKN@SDSC.BITNET
X; SPAN:`009`009SDSC::GKN (27.1)
X; MFENET:`009GKN@SDS.MFENET
X; SDSCNET:`009GKN@SDS.SDSCNET
X;
X;
X; Modifications:
X;
X;
X;-
X
X`009.Page
X`009.Subtitle`009Local definitions
X
V`009.Link`009 "SYS$SYSTEM:SYS.STB"/Selective_Search`009;Grab the system symbo
Xl table
X`009.Library "SYS$LIBRARY:LIB.MLB"`009`009`009;Get special macros from here
X
X`009.NoCross`009`009`009;Save a tree
X
X`009$CHFDEF`009`009`009`009;Define condition handler stuff
X`009$DCDEF`009`009`009`009;Device class & type definitions
X`009$SSDEF`009`009`009`009;System service codes
X`009$STSDEF`009`009`009`009;Define severity codes
X`009$TPADEF`009`009`009`009;TPARSE definitions
X`009$TTYUCBDEF`009`009`009;Terminal UCB offsets
X`009$UCBDEF`009`009`009`009;UCB offsets
X
X`009.Cross`009`009`009`009;Turn CREF back on
X
X
X; Local macros
X
X; Item:`009`009Make an item list entry for $GETxxI
X
V.Macro`009Item`009Type=DVI,Item=,Length=4,RetAdr=,RetLen= ;Make an item list
X entry for $GETxxI
X`009.Word`009Length,Type'$_'Item`009;Length,,what
X`009.Address RetAdr`009`009`009;Put it here
X`009.If`009NB,RetLen`009`009;If we have an explicit return length
X`009.Address RetLen`009`009`009; then use it
X`009.Iff`009`009`009`009;  else
X`009.Long`0090`009`009`009;   we don't care
X`009.Endc`009`009`009`009;`009...
X.Endm`009Item`009`009`009`009;`009...
X
X; .Ascip:`009Create a pointer to an .Ascid string
X
V.Macro`009.Ascip`009STRING,?A`009`009;Point to a string descriptor in another
X PSECT
X`009.Enable`009LSB`009`009`009;Turn on the local symbol block
X`009.Save`009`009`009`009;Save the current PSECT
X`009.Psect`009STRINGS NOEXE,RD,NOWRT,PIC,SHR,PAGE
XA:`009.Ascid`009\'STRING\`009`009;String
X`009.Restore`009`009`009;Restore the current PSECT
X`009.Address A`009`009`009;Store pointer to the string
X`009.Disable LSB`009`009`009;Turn off the local symbol block
X.Endm`009.Ascip`009`009`009`009;       ...
X
X`009.Page
X`009.Subtitle`009TPARSE state table
X
X;+
X;
X; ----- TPARSE state table
X;
X;
X; Valid commands:
X;
X;`009HELP or ?`009`009- Print a short help message
X;`009SET <device> <string>`009- Set  the ACCPORNAM for <device> to <string>
X;`009SHOW <device>`009`009- Show the ACCPORNAM for <device>
X;`009EXIT`009`009`009- Quit
X;
X;-
X
X`009$INIT_STATE`009ACCP_STATES,ACCP_KEYS`009;Initialize the state table
X
X; Parse the major verb.
X
X`009$STATE`009`009`009`009`009;First state
X
X`009$TRAN`009TPA$_STRING,,UPCASE`009`009;Upcase the first token (!)
X`009$TRAN`009TPA$_EOS,TPA$_EXIT`009`009;Ignore empty commands
X`009$TRAN`009'?',TPA$_EXIT,HELP`009`009;Print help
X`009$TRAN`009'EXIT',TPA$_EXIT,RET_EOF`009;Quit
X`009$TRAN`009'HELP',TPA$_EXIT,HELP`009`009;    ...
X`009$TRAN`009'SET',ST_SET`009`009`009;Set the ACCPORNAM
X`009$TRAN`009'SHOW',ST_SHOW`009`009`009;Show the ACCPORNAM
X
X; Set <device> <string>
X
X`009$STATE`009ST_SET`009`009`009`009;Set the ACCPORNAM
X
X`009$TRAN`009TPA$_FILESPEC,,CHECK_DEVICE`009;Go check the device name out
X
X`009$STATE`009`009`009`009`009;Here to set the string
X
X`009$TRAN`009!ST_NAME,TPA$_EXIT,SET_ACCP`009;Go set the string
X
X; Show <device>
X
X`009$STATE`009ST_SHOW`009`009`009`009  ;Show the ACCPORNAM
X
X`009$TRAN`009TPA$_FILESPEC,TPA$_EXIT,SHOW_ACCP ;Go show the access port name
X
X; Sub-expression to swallow stuff until EOS.
X
X`009$STATE`009ST_NAME`009`009`009`009;Sub-expression to collect until EOS
X
X`009$TRAN`009TPA$_LAMBDA,,BLANKS_VISIBLE`009;Make blanks visible again
X
X`009$STATE`009ST_NAME_1`009`009`009;Here to collect until EOS
X
X`009$TRAN`009TPA$_EOS,TPA$_EXIT`009`009;Quit at EOS
X`009$TRAN`009TPA$_ANY,ST_NAME_1`009`009;Else munch another character
X
X`009$END_STATE`009`009`009`009;End of the state table
X
X`009.Page
X`009.Subtitle`009Impure storage
X
X`009.Psect`009IMPURE_DATA`009NOEXE,RD,WRT,PIC,NOSHR,PAGE
X
X
X; TPARSE parameter block.
X
XTPARSE_BLOCK:`009.Long`009TPA$K_COUNT0`009;Argument count
X`009`009.Blkb`009TPA$K_LENGTH0-4`009;Allocate the rest of the block
X
X
X; Random other crud.
X
XDEVICE_CLASS:`009.Blkl`009`009`009;Device class
XDEVICE_STS:`009.Blkl`009`009`009;Device status
XDEVICE_DESC:`009.Blkl`009`009`009;Device name
X`009`009.Address DEVICE_BUFF`009; descriptor
XACCP_DESC:`009.Blkl`009`009`009;Access Port Name
X`009`009.Address ACCP_BUFF`009; descriptor
XTT_DESC:`009.Blkl`009`009`009;Physical terminal
X`009`009.Address TT_BUFF`009; descriptor
X
XIN_BUFF:`009.Blkb`009128`009`009;Command input buffer
XTT_BUFF:`009.Blkb`00964`009`009;Physical terminal name buffer
XDEVICE_BUFF:`009.Blkb`00964`009`009;Device name buffer
XACCP_BUFF:`009.Blkb`00964`009`009;Access Port Name buffer
X
X`009.Page
X`009.Subtitle`009Pure storage
X
X`009.Psect`009PURE_DATA`009NOEXE,RD,NOWRT,PIC,SHR,PAGE
X
X
X; $GETDVI wish list.
X
XDVI_LIST:`009Item`009Item=DEVCLASS,-`009`009;Get the device class
X`009`009`009RetAdr=DEVICE_CLASS`009;Put it here
X`009`009Item`009Item=STS,-`009`009;Get the device status word
X`009`009`009RetAdr=DEVICE_STS`009;Put it here
X`009`009Item`009Item=TT_PHYDEVNAM,-`009;Get the device name
X`009`009`009Length=64,-`009`009;It can be this big
X`009`009`009RetAdr=TT_BUFF,-`009;Put it here
X`009`009`009RetLen=TT_DESC`009`009;Return the length here
X`009`009Item`009Item=TT_ACCPORNAM,-`009;Get the Access Port Name
X`009`009`009Length=64,-`009`009;It can be this big
X`009`009`009RetAdr=ACCP_BUFF,-`009;Put it here
X`009`009`009RetLen=ACCP_DESC`009;Return the length here
X`009`009Item`009Item=DEVNAM,-`009`009;Get the device name
X`009`009`009Length=64,-`009`009;It can be this big
X`009`009`009RetAdr=DEVICE_BUFF,-`009;Put it here
X`009`009`009RetLen=DEVICE_DESC`009;Return the length here
X`009`009.Long`0090`009`009`009;That's all
X
X
X; Help text.
X
XHELP_TEXT:`009.Ascip`009<>
X`009`009.Ascip`009<Commands:>
X`009`009.Ascip`009<>
X`009`009.Ascip`009<EXIT`009`009`009- Exit the program>
V`009`009.Ascip`009<SET device string`009- Set  the ACCPORNAM for device to st
Xring>
X`009`009.Ascip`009<SHOW device`009`009- Show the ACCPORNAM for device>
X`009`009.Ascip`009<>
X`009`009.Long`0090
X
X
X; Other random text.
X
XPROMPT:`009`009.Ascid`009"ACCP> "
XUS:`009`009.Ascid`009"ACCP"
X
X`009.Page
X`009.Subtitle`009Entry point
X
X`009.Psect`009CODE`009`009EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`009.Entry`009START,`094M<>`009`009;Entry here
X
X`009MOVAB`009COND_HANDLER,(FP)`009;Establish a condition handler
X`009MOVAL`009TPARSE_BLOCK,R11`009;Address our TPARSE block
X
X; Loop here reading commands from SYS$INPUT.
X
X10$:`009MOVZBL`009#128,TPA$L_STRINGCNT(R11)    ;Reset the input
X`009MOVAB`009IN_BUFF,TPA$L_STRINGPTR(R11) ; descriptor
X`009MOVL`009#TPA$M_ABBREV,-`009`009     ;Reset the
X`009`009TPA$L_OPTIONS(R11)`009     ; TPARSE options
X`009PUSHAW`009TPA$L_STRINGCNT(R11)`009     ;Return the length here
X`009PUSHAQ`009PROMPT`009`009`009     ;Prompt with this
X`009PUSHAQ`009TPA$L_STRINGCNT(R11)`009     ;Here's the input buffer
X`009CALLS`009#3,G`094LIB$GET_INPUT`009     ;Fetch some input
X`009BLBC`009R0,20$`009`009`009     ;Presume EOF
X`009TSTW`009TPA$L_STRINGCNT(R11)`009     ;Any input?
X`009BEQL`00910$`009`009`009     ;If EQL no, ask again
X
X; Feed the command to TPARSE.  Command execution handled by TPARSE
X; action routines.
X
X`009PUSHAL`009ACCP_KEYS`009`009;Stack the keyword table address
X`009PUSHAL`009ACCP_STATES`009`009;Stack the state table address
X`009PUSHL`009R11`009`009`009;Stack the TPARSE block address
X`009CALLS`009#3,G`094LIB$TPARSE`009`009;Parse the command
X`009BLBS`009R0,10$`009`009`009;Win!
X
X; Here on some sort of error.
X
X20$:`009CMPL`009#RMS$_EOF,R0`009`009;End of file?
X`009BEQL`00940$`009`009`009;If EQL yes, not an error
V`009BBS`009#STS$V_INHIB_MSG,R0,10$`009;Branch if we've already signalled the
X error
X`009CMPL`009#LIB$_SYNTAXERR,R0`009;Syntax error?
X`009BNEQ`00930$`009`009`009;If NEQ no, a real problem
X`009PUSHAQ`009TPA$L_TOKENCNT(R11)`009;Else stack the token descriptor address
X`009PUSHL`009#1`009`009`009;1 FAO argument
X`009PUSHL`009#ACCP$_SYNTAX`009`009;Stack the error code
X`009CALLS`009#3,G`094LIB$SIGNAL`009`009;Signal the error
X`009BRB`00910$`009`009`009;And loop
X
X; Here on some drastic error.
X
X30$:`009PUSHL`009R0`009`009`009;Stack the error
X`009CALLS`009#1,G`094LIB$STOP`009`009;Punt.
X
X; Here to exit peacefully.
X
X40$:`009MOVL`009#SS$_NORMAL,R0`009`009;Success
X`009RET`009`009
X
X`009.Page
X`009.Subtitle`009HELP`009`009- List brief help
X
X;+
X;
X; ----- HELP:  List brief help
X;
X;
X; This routine is called as a TPARSE action routine to print
X; brief help on SYS$OUTPUT.
X;
X; Inputs:
X;
X;`009HELP_TEXT`009- Table of help text pointers.
X;
X; Outputs:
X;
X;`009As described above.
X;
X;-
X
XHELP:`009.Word`009`094m<R2>`009`009`009;List brief help
X
X`009MOVAL`009HELP_TEXT,R2`009`009;Address the help text
X
X10$:`009PUSHL`009(R2)+`009`009`009;Stack the next descriptor address
X`009BEQL`00920$`009`009`009;If EQL we're done
X`009CALLS`009#1,G`094LIB$PUT_OUTPUT`009;Display it
X`009BRB`00910$`009`009`009;Around and around we go
X
X20$:`009RET`009`009`009`009;Done
X
X`009.Page
X`009.Subtitle`009RET_EOF`009`009- Return RMS$_EOF
X
X;+
X;
X; ----- RET_EOF:  Return RMS$_EOF
X;
X;
X; This routine is called as a TPARSE action routine for the EXIT command.
X;
X; Inputs:
X;
X;`009None
X;
X; Outputs:
X;
X;`009R0`009- RMS$_EOF
X;
X;-
X
XRET_EOF: .Word`009`094m<>`009`009`009;Return RMS$_EOF
X
X`009MOVL`009#RMS$_EOF,R0`009`009;Return
X`009RET`009`009`009`009; RMS$_EOF
X
X`009.Page
X`009.Subtitle`009CHECK_DEVICE`009- Ensure that the device is a terminal
X
X;+
X;
X; ----- CHECK_DEVICE:  Ensure that the device is a terminal
X;
X;
X; This routine will ensure that the target device is a terminal
X; and is not a "ephemeral" device.
X;
X; Inputs:
X;
X;`009TPA$L_TOKENCNT(AP)`009- A descriptor of the device name
X;
X; Outputs:
X;
X;`009R0`009- Success or failure
X;
X;-
X
XCHECK_DEVICE: .Word `094m<>`009`009`009;Ensure that the device is a terminal
X
X; Get the scoop on this device
X
X`009$GETDVIW_S DEVNAM=TPA$L_TOKENCNT(AP),-`009;Fetch the
X`009`009ITMLST=DVI_LIST`009`009`009; poop on this device
X`009BLBC`009R0,10$`009`009`009`009;Lose!
X
X; Reject if it's not a terminal, off line, or a template device.
X
-+-+-+-+-+ End of part 1 +-+-+-+-+-

