From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  7-JUL-1989 18:33
To:	MRGATE::"ARISIA::EVERHART"
Subj:	LOGINOUT_HACK part 1 of 2

Received: From KL.SRI.COM ([0.0.0.0]) by CRVAX.SRI.COM with TCP; Fri,  7 JUL 89 14:29:47 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Fri, 7 Jul 89 14:24:13 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA10021; Fri, 7 Jul 89 14:14:49 -0700
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: 7 Jul 89 18:59:11 GMT
From: gkn@mcnc.org  (Gerard K. Newman)
Organization: North Carolina Supercomputing Center
Subject: LOGINOUT_HACK part 1 of 2
Message-Id: <4834@alvin.mcnc.org>
References: <1463@ndmath.UUCP>, <4804@alvin.mcnc.org>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

$! ................... 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 30-JUN-1989 18:24:59.59.
$!
$! 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 4 files:
$!        LOGINOUT_HACK.MAR
$!        LOGINOUT_HACK.COM
$!        LOGINOUT_HACK.OPT
$!        LOGINOUT_HACK.README
$!
$!============================================================================
$ 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 = "LOGINOUT_HACK.MAR"
$ CHECKSUM_IS = 639179320
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
V`009.Title`009Loginout_Hack`009- Loginout hack for SDSC CTSS terminal gateway
Xs
X`009.Ident`009/V01.003/
X`009.Enable`009SUP
X`009.Subtitle`009Introduction
X
X;+
X;
X; ----- Loginout_Hack:  Loginout hack for SDSC CTSS terminal gateways
X;
X;
X; Facility:
X;
X;`009Terminal access to CTSS.
X;
X; Abstract:
X;
X;`009This program provides a replacement for the real LOGINOUT which
X;`009instead  contacts  the CTSS  terminal gateway  kernel  to allow
X;`009interactive  login to CTSS  systems.  The  user may  optionally
X;`009type a `094\ to invoke the real LOGINOUT.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V5.0 or later, CMKRNL, SYSNAM, SYSPRV,
X;`009LOG_IO, ALTPRI, and TMPMBX privileges.
X;
X;
X;
X; Version:`009V01.003
X; Date:`009`00930-May-1989
X;
X; Copyright `169 1989  San Diego Supercomputer Center
X;
X; Gerard K. Newman`009
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;`00916-May-1989`009GKN`009Always crank LOGINOUT if our terminal is OPA0:.
X;`009`009`009`009To avoid global section conflicts we copy
X;`009`009`009`009DEC's LOGINOUT to DEC_LOGINOUT.EXE, install
X;`009`009`009`009it, and invoke it instead.
X;`00921-May-1989`009GKN`009Leading <CR><LF> on ID: looks better.
X;`00930-May-1989`009GKN`009If CTSS_GATE doesn't respond don't dump the
X;`009`009`009`009user into the real loginout -- output an
X;`009`009`009`009error message instead.
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$DCDEF`009`009`009`009;Device class & type definitions
X`009$DVIDEF`009`009`009`009;DVI item codes
X`009$IACDEF`009`009`009`009;Image activator stuff
X`009$IHDDEF`009`009`009`009;Image header format
X`009$IODEF`009`009`009`009;I/O function codes
X`009$JPIDEF`009`009`009`009;JPI item codes
X`009$LNMDEF`009`009`009`009;Define logical name stuff
X`009$PCBDEF`009`009`009`009;Process control block offsets
X`009$PRVDEF`009`009`009`009;Define privilege bits
X`009$RMSDEF`009`009`009`009;RMS junk
X`009$SSDEF`009`009`009`009;System service codes
X`009$SYIDEF`009`009`009`009;$GETSYI item codes
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`009.Page
X`009.Subtitle`009Impure storage
X
X`009.Psect`009IMPURE_DATA`009NOEXE,RD,WRT,PIC,NOSHR,PAGE
X
X
X; Random data.
X
XIOSB:`009`009.Blkq`009`009`009;General I/O status block
XDEVCLASS:`009.Blkl`009`009`009;Device class for SYS$INPUT
XOWNER:`009`009.Blkl`009`009`009;Our owner PID
XPCB_STS:`009.Blkl`009`009`009;A copy of PCB$L_STS
XMAP_RANGE:`009.Long`009512,512*512`009;Space to map the real loginout into
XMBX_CHAN:`009.Blkw`009`009`009;Channel to talk to SDSC$CTSS_MBX
XTT_CHAN:`009.Blkw`009`009`009;Channel to SYS$INPUT
XDEV_LENG:`009.Blkl`009`009`009;Length of our real device name
XHERALD_LENG:`009.Blkl`009`009`009;Length of our herald equivalence name
XLGI_PWD_TMO:`009.Blkl`009`009`009;Password timeout in seconds
XUIC_GROUP:`009.Blkl`009`009`009;Our UIC group
XMAXSYSGROUP:`009.Blkl`009`009`009;MAXSYSGROUP
XPROCPRIV:`009.Blkq`009`009`009;Our default privilege mask
XOUT_DESC:`009.Long`009256`009`009;Output buffer
X`009`009.Address MBX_BUFF`009; descriptor
X
XDEVICE:`009`009.Blkb`00964`009`009;Space for the real device name
XIMAGE_HEADER:`009.Blkb`009512`009`009;Space for the image header
XMBX_BUFF:`009.Blkb`009512`009`009;Mailbox message buffer
XHERALD_BUFF:`009.Blkb`009256`009`009;Space for our herald
X
X`009.Page
X`009.Subtitle`009Pure storage
X
X`009.Psect`009PURE_DATA`009NOEXE,RD,NOWRT,PIC,SHR,PAGE
X
X
X; Random data.
X
VSYSPRV:`009`009.Long`009PRV$M_SYSPRV,0`009    ;To enable and disable SYSPRV i
Xf need be
XDELTA_30:`009.Long`009-10*1000*1000*30,-1 ;30 seconds, delta time style
XOOB_MASK:`009.Long`0090`009`009    ;Short form terminator mask
X`009`009.Long`009`094x10000000`009    ;`094\
X
X
X; JPI wish list.
X
XJPI_LIST:`009Item`009Type=JPI,-`009 ;Get some JPI
X`009`009`009Item=OWNER,-`009 ;Get our owner PID
X`009`009`009RetAdr=OWNER`009 ;Put it here
X`009`009Item`009Type=JPI,-`009 ;Get some JPI
X`009`009`009Item=STS,-`009 ;Get a copy of PCB$L_STS
X`009`009`009RetAdr=PCB_STS`009 ;Put it here
X`009`009Item`009Type=JPI,-`009 ;Get some JPI
X`009`009`009Item=GRP,-`009 ;Get our UIC group
X`009`009`009RetAdr=UIC_GROUP ;Put it here
X`009`009Item`009Type=JPI,-`009 ;Get some JPI
X`009`009`009Item=PROCPRIV,-`009 ;Get our default privilege mask
X`009`009`009Length=8,-`009 ;All 8 bytes of it
X`009`009`009RetAdr=PROCPRIV`009 ;Put it here
X`009`009.Long`0090`009`009 ;That's all
X
X
X; DVI wish list.
X
XDVI_LIST:`009Item`009Type=DVI,-`009    ;Get some DVI
X`009`009`009Item=DEVCLASS,-`009    ;Get the device class
X`009`009`009RetAdr=DEVCLASS`009    ;Put it here
X`009`009Item`009Type=DVI,-`009    ;Get some DVI
X`009`009`009Item=TT_PHYDEVNAM,- ;Get the physical device name
X`009`009`009RetAdr=DEVICE,-`009    ;Put it here
X`009`009`009RetLen=DEV_LENG,-   ;Return the length here
X`009`009`009Length=64`009    ;The buffer is this big.
X`009`009.Long`0090`009`009    ;That's all
X
X
X; LNM wish list.
X
XLNM_LIST:`009Item`009Type=LNM,-`009     ;Get some LNM info
X`009`009`009Item=STRING,-`009     ;Get the translation
X`009`009`009RetAdr=HERALD_BUFF,- ;Put it here
X`009`009`009RetLen=HERALD_LENG   ;Return the length here
X`009`009.Long`0090`009`009     ;That's all
X
X
X; SYI wish list.
X
XSYI_LIST:`009Item`009Type=SYI,-`009   ;Get some system info
X`009`009`009Item=LGI_PWD_TMO,- ;Get the login password timeout
X`009`009`009RetAdr=LGI_PWD_TMO ;Put it here
X`009`009Item`009Type=SYI,-`009   ;Get some system info
X`009`009`009Item=MAXSYSGROUP,- ;Get MAXSYSGROUP
X`009`009`009RetAdr=MAXSYSGROUP ;Put it here
X`009`009.Long`0090`009`009   ;That's all
X
X
X; DVI argument list.
X
XDVI_ARGS:`009$GETDVI`009DEVNAM=SYS$INPUT,- ;Build the $GETDVI
X`009`009`009ITMLST=DVI_LIST`009   ; argument list
X
X
X; Random strings.
X
XLOGINOUT:`009.Ascid`009"SYS$SYSTEM:DEC_LOGINOUT.EXE"
XPROMPT:`009`009.Ascic`009<13><10>"ID: "
XHERALD:`009`009.Ascid`009"SDSC$CTSS_HERALD"
XSYS$INPUT:`009.Ascid`009"SYS$INPUT"
XLNM$PROCESS:`009.Ascid`009"LNM$PROCESS"
XCTSS_MBX:`009.Ascid`009"SDSC$CTSS_GATE"
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; Get the login password timeout (a nice touch) and MAXSYSGROUP.
X
X`009$GETSYIW_S ITMLST=SYI_LIST`009;Get LGI_PWD_TMO
X
X; Get our owner PID to see if we're a subprocses.
X
X`009$GETJPIW_S ITMLST=JPI_LIST`009;Get some info about ourselves
X`009TSTL`009OWNER`009`009`009;Are we a subprocess?
X`009BNEQ`00910$`009`009`009;If NEQ yes, crank the real loginout
X`009BITL`009#<PCB$M_NETWRK!-`009;Are we network?
X`009`009  PCB$M_BATCH>,PCB_STS`009; or batch?
X`009BNEQ`00910$`009`009`009;If NEQ yes, crank loginout
X
X; Check to see if we're logging out.
X
X`009TSTW`009G`094CTL$AG_CLIDATA`009;Are we logged in already?
X`009BNEQ`00910$`009`009`009;If NEQ yes, go log out.
X
X; Go fish up the device class for SYS$INPUT.  Do this in executive mode so
X; we'll ignore any user-mode definitions of SYS$INPUT.
X
X`009$CMEXEC_S ROUTIN=SYS$GETDVIW,-`009;Execute this in
X`009`009ARGLST=DVI_ARGS`009`009; executive mode
X`009BLBC`009R0,10$`009`009`009;Lose?
X`009CMPL`009#DC$_TERM,DEVCLASS`009;Are we on a terminal?
X`009BNEQ`00910$`009`009`009;If NEQ no.
X
X; Check to see if we're on _OPA0:, and crank LOGINOUT if so.
X
X`009CMPL`009#`094a/OPA0/,DEVICE+1`009;Are we on _OPA0:?
X`009BEQL`00910$`009`009`009;If EQL yes, VMS login always
X
X; Next, attempt to assign an I/O channel to the gateway mailbox.
X; If it doesn't exist then simply crank the real loginout.
X
X`009$ASSIGN_S DEVNAM=CTSS_MBX,-`009;Grab an I/O channel
X`009`009CHAN=MBX_CHAN`009`009; to the CTSS gateway mailbox
X`009BLBC`009R0,10$`009`009`009;Presume it's not there, go crank loginout
X
X; Ok - we've gotten far enough to know that:
X;
X;`009- We're not logged in
X;`009- We're on a real terminal
X;`009- The CTSS gateway is there
X;
X; So, go fetch the CTSS login line et. al.
X
X`009BSBW`009CTSS_LOGIN`009`009;Go do CTSS login stuff
X
X; Here to crank up the real loginout.  We do this with a merged
X; image activation into our low address space.  We'd like to be
X; able to do this with IAC$M_EXPREG, except that the assembler
X; is too stupid to put out a .ADDRESS fixup for .ASCID directives.
X
X10$:`009$IMGACT_S NAME=LOGINOUT,-`009;Crank the real loginout
X`009`009HDRBUF=IMAGE_HEADER,-`009;Put the image header here
X`009`009IMGCTL=#IAC$M_MERGE,-`009;Merge it into our address space
X`009`009INADR=MAP_RANGE,-`009;Map it here
X`009`009RETADR=MAP_RANGE`009;Tell me where you put it
X`009BLBC`009R0,40$`009`009`009;Lose!!
X`009$IMGFIX_S`009`009`009;Process the fixup vector list
X`009BLBC`009R0,40$`009`009`009;Lose!!
X
X; Call the real LOGINOUT at it's transfer address.  Note that we don't
X; call the SYS$IMGSTA transfer address since it never returns control.
X; Also note  that there isn't a  global symbol for the new SYS$IMGSTA,
X; so we have to use a hex constant (boo hiss!!).
X
X`009MOVL`009IMAGE_HEADER,R2`009`009;Address the image header
V`009MOVZWL`009IHD$W_ACTIVOFF(R2),R1`009;Fetch the offset to the transfer addr
Xess array
X`009ADDL`009R1,R2`009`009`009;Address same
X`009MOVL`009#3,R3`009`009`009;Loop limit
X
X20$:`009MOVL`009(R2)+,R1`009`009;Fetch the next transfer address
X`009BEQL`00940$`009`009`009;If EQL we're done.
X`009CMPL`009R1,#`094x7FFEDF68`009`009;*CROCK* is it the new SYS$IMGSTA?
X`009BEQL`00930$`009`009`009;If EQL yes, don't call it.
X`009CALLG`009(AP),(R1)`009`009;Else call this entry point
X`009BLBC`009R0,40$`009`009`009;Lossage!
X
X30$:`009SOBGTR`009R3,20$`009`009`009;Loop through the entire array
X`009MOVL`009#SS$_NORMAL,R0`009`009;Success
X
X40$:`009BRW`009ERROR_EXIT`009`009;Lossage.
X
X`009.Page
X`009.Subtitle`009CTSS_LOGIN`009- Grab a CTSS login line
X
X;+
X;
X; ----- CTSS_LOGIN:  Grab a CTSS login line
X;
X;
X; This routine is called to collect the CTSS login line.  We display
X; the herald message (if we have one) and prompt for input.  If the
X; user types  `094\ then we'll return and crank the real loginout.  If
-+-+-+-+-+ End of part 1 +-+-+-+-+-

