From:	MERC::"uunet!WKUVX1.BITNET!MacroMan" 22-MAY-1992 19:21:36.07
To:	MACRO32@WKUVX1.BITNET
CC:	
Subj:	loginout_hack.share (1/2)

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 22-MAY-1992 00:43:40.12   By user GKN
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. LOGINOUT_HACK.README;3
$!       2. LOGINOUT_HACK.OPT;1
$!       3. LOGINOUT_HACK.MAR;28
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "V4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X
X`009Copy SYS$COMMON:`091SYSEXE`093LOGINOUT.EXE to SYS$COMMON:`091SYSEXE`093D
VEC_LOGINOUT.EXE
X
X`009Copy LOGINOUT_HACK.EXE to SYS$SPECIFIC:`091SYSEXE`093LOGINOUT.EXE
X
X`009Install it with CMKRNL, SYSNAM, SYSPRV, LOG_IO, ALTPRI and TMPMBX
X`009privileges (/OPEN/HEADER/SHARED won't hurt, either).
X
X`009BE SURE that DEC_LOGINOUT.EXE is installed the same way.
X
X`009If DEC's LOGINOUT grows much it will be necessary to change the
X`009second longword of MAP_RANGE and the linker options file to a
X`009larger number (right now it's set up for 512 pages).
X
$ CALL UNPACK LOGINOUT_HACK.README;3 493112948
$ create/nolog 'f'
XBase`009= 262144`009`009!512*512
$ CALL UNPACK LOGINOUT_HACK.OPT;1 1750685460
$ create/nolog 'f'
X`009.Title`009Loginout_Hack`009- Loginout hack for SDSC CTSS terminal gatewa
Vys
X`009.Ident`009/V01.005/
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\ , VMS or UNICOS 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.005
X; Date:`009`00926-Feb-1990
X;
X; Copyright `169 1989, 1990  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;
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;`00926-Jul-1989`009SZ`009Add timeout function modifyer to the CTSS
X;`009`009`009`009login line.
X;`00908-Sep-1989`009SZ`009Add code to check you have really got the AST
X;`00908-Sep-1989`009SZ`009Add code to accept VMS or UNICOS instead od an out
V-of-band character
X;`009 6-Feb-1990`009GKN`009Recognize DECwindows terminal devices.  Random cl
Veanup.
X;`00926-Feb-1990`009GKN`009More cleanup (missed the improper use of OOB_MASK
V in
X;`009`009`009`009checking for an AST hit the last time thru ...).
X;
X;-
X
X`009.Page
X`009.Subtitle`009Local definitions
X
X`009.Link`009 "SYS$SYSTEM:SYS.STB"/Selective_Search`009;Grab the system symb
Vol 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
X.Macro`009Item`009Type=DVI,Item=,Length=4,RetAdr=,RetLen= ;Make an item list
V 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
XOOB_MASK:`009.Long`0090`009`009;Short form terminator mask
X`009`009.Long`009`094x10000000`009;`094\`032
XAST_HIT:`009.Long`0090`009`009;AST hit?
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
XSYSPRV:`009`009.Long`009PRV$M_SYSPRV,0`009    ;To enable and disable SYSPRV
V if need be
XDELTA_30:`009.Long`009-10*1000*1000*30,-1 ;30 seconds, delta time style
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; Check to see if we're on a DECwindows terminal, and crank LOGINOUT if so.
X
X`009CMPW`009#`094a/TW/,DEVICE+1`009;DECwindows terminal?
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
X`009MOVZWL`009IHD$W_ACTIVOFF(R2),R1`009;Fetch the offset to the transfer add
Vress 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.
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
--
gkn     Gerard K. Newman        gkn@tgv.com     619.591.4717 (voice/fax)
        TGV, Inc.               ucsd!gkn        408.427.4366
        603 Mission Street
        Santa Cruz, CA  95060
