%( **************************************************************** Copyright (c) 1992, Carnegie Mellon University All Rights Reserved Permission is hereby granted to use, copy, modify, and distribute this software provided that the above copyright notice appears in all copies and that any distribution be for noncommercial purposes. Carnegie Mellon University disclaims all warranties with regard to this software. In no event shall Carnegie Mellon University be liable for any special, indirect, or consequential damages or any damages whatsoever resulting from loss of use, data, or profits arising out of or in connection with the use or performance of this software. **************************************************************** )% %TITLE 'TCP_TELNET - TELNET Virtual Terminal service' %( Facility: TCP_TELNET - Run incoming TELNET service under TCP (RFC 854) Abstract: Supports incoming TELNET virtual terminal traffic by routing TCP data between pseudo-terminals and the rest of the IPACP. Author: Vince Fuller, CMU-CSD, Summer, 1987 Copyright (c) 1987, Vince Fuller and Carnegie-Mellon University Module Modification History: 1.11 7-Jan-1992 John Clement Put in hold off in PTY_WRITE until process is available on Terminal side. And fixed LOG$TVT write in PTY_Write. 1.10 3-Dec-1991 John Clement Rice University (JC) Binary_On, Binary_Off added to turn on/off EIGHTBIT,PASTHRU Extended_ASCII_On,Off added to trun on/off EIGHTBIT 1.9 14-Nov-1991 Henry W. Miller USBR Rework TELNET server logic. Changes are too numerous to list, but highlights are: TELNET_INPUT() and TELNET_OUTPUT() now call the PTY I/O routines rather than the TCP I/O routines. PTY_READ() and PTY_WRITE() now call the TCP I/O routines, rather than vice versa. New routine NET_TO_PTY() now fills the PTY buffer from the TCP buffer, and handles buffer wrapping and overflow properly. PTY_WRITE() now handles buffer wrapping and overflow properly. Call TCP$Enqueue_ACK() rather than setting PENDING_ACK. 1.8 13-Nov-1991 Edit by John M. Clement(JC) Rice University Modified to make Negotiations work. 1.7 15-Oct-1991 Henry W. Miller USBR Rearrange logging code in PTY_WRITE() so we can see how many bytes would have been written if the $QIO fails. 1.6 18-Jul-1991 Henry W. Miller USBR Use LIB$GET_VM_PAGE and LIB$FREE_VM_PAGE rather then LIB$GET_VM and LIB$FREE_VM. 1.5 28-Jan-1991 Henry W. Miller USBR Make ACK_THRESHOLD a configurable variable. 1.4 04-Sep-1989 Bruce R. Miller CMU Network Development Adding support for LineMode option 1.3 15-Dec-1988, Edit by Simon Hackett, University of Adelaide, Australia Routine PTY_SET_OWNER_PID to allow identification of the PID of a TELNET session. 1.2 20-Feb-1989 Bruce R. Miller CMU Network Development Added support for several new options: Timing-Mark, Window-Size, Terminal-Type, Remote-Flow-control. 1.2 01-Feb-1989 Bruce R. Miller CMU Network Development Added routine TCP_ADD_STRING() to send a string over the net. Added AYT (Are you there?) recognition & response. 1.2 09-JUN-1988 Dale Moore CMU-CS/RI Modified to return to State Normal upon receiving IAC or IAC . Also be willing to negotiate Supress GA in both directions. 1.1 19-Nov-87, Edit by VAF $ACPWAKE macro is now in TCPMACROS.REQ. 1.0 31-Jul-87, Edit by VAF Initial version. Loosely based on Dale Moore's TELNET_SERVER. )% MODULE TELNET(IDENT='1.11',LANGUAGE(BLISS32), ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE), LIST(REQUIRE,ASSEMBLY,OBJECT,BINARY), OPTIMIZE,OPTLEVEL=3,ZIP)= BEGIN !!!HACK!!! why does this module make so many refs to AST_in_Progress? LIBRARY 'SYS$LIBRARY:STARLET'; ! VMS system definitions LIBRARY 'CMUIP_SRC:[CENTRAL]NETXPORT'; ! BLISS common definitions LIBRARY 'CMUIP_SRC:[CENTRAL]NETERROR'; ! Network error codes LIBRARY 'CMUIP_SRC:[CENTRAL]NETVMS'; ! VMS-specific definitions LIBRARY 'TCPMACROS'; ! System-wide Macro definitions LIBRARY 'STRUCTURE'; ! System-wide structure definitions LIBRARY 'TCP'; ! TCP related definitions LIBRARY 'TELNET'; ! TELNET protocol definitions EXTERNAL LOCAL_NAME, AST_IN_PROGRESS; EXTERNAL LITERAL M$INTERNAL : UNSIGNED(8); EXTERNAL ROUTINE TCP$TCB_CLOSE, TCB$Create, TCB$Delete : NOVALUE, TCP$Enqueue_Ack : NOVALUE, TCP$Send_Ack : NOVALUE, TCP$Send_Data, TCP$TCB_Init, TIME_STAMP, Check_Unique_Conn, Conect_Insert : NOVALUE; LITERAL TVT_OPEN_TIMEOUT = 120*CSEC; ! Amount of time to wait for TVT to open LITERAL ! Telnet$K_Char_AO = %O'17', ! Control-O Telnet$K_Char_AYT = %O'24', ! Control-T Telnet$K_Char_Brk = %O'31', ! Control-Y Telnet$K_Char_EC = %O'177', ! DEL Telnet$K_Char_Purge = %X'18', ! Control-X Telnet$K_Char_EL = %O'25', ! Control-U Telnet$K_Char_IP = %O'03'; ! Control-C. %SBTTL 'TELNET definitions' ! Define the structure of a PTY status block $FIELD PTY$IOSB_FIELDS = SET PTSB$STATUS = [$UWORD], ! $QIO status PTSB$NBYTES = [$UWORD], ! Number of bytes transferred PTSB$EXTRA1 = [$UWORD], ! Extra information PTSB$EXTRA2 = [$UWORD] ! Extra information TES; LITERAL PTY$IOSB_SIZE = $FIELD_SET_SIZE; MACRO PTY$IOSB = BLOCK[PTY$IOSB_SIZE] FIELD(PTY$IOSB_FIELDS) %; ! USE_ASTS nonzero means we should do all TCP I/O at AST level and thus it is ! OK to directly call TCP_READ and TCP_WRITE in AST routines. COMPILETIME USE_ASTS = 1; %SBTTL 'Module data' BIND PTY_NAME = %ASCID'INET$PTY', AYT_RESPONSE = %ASCID'[definitely]'; ! Define the default options state for new TVTs EXTERNAL ROUTINE Timing_Mark_On, Terminal_Type_On, Terminal_Type_Sub, Window_Size_On, Window_Size_Sub, Set_DEVDEP, ! JC LineMode_Sub; OWN DEFAULT_OPTION_BLOCK : OPT$BLOCK PRESET( [OPT$STATE] = OPT$STATE_OFF, [OPT$CURRENT] = FALSE, [OPT$PREFER] = OPT$STATE_OFF), TVT_DEF_LOCAL : OPT$LIST PRESET( [TELNET$K_BINARY, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_BINARY, OPT$CURRENT] = FALSE, [TELNET$K_BINARY, OPT$PREFER] = OPT$DONT_CARE, [TELNET$K_BINARY, OPT$ON_RTN] = Set_DEVDEP, !JC [TELNET$K_BINARY, OPT$OFF_RTN] = Set_DEVDEP, !JC [TELNET$K_ECHO, OPT$STATE] = OPT$STATE_OFF, !JC [TELNET$K_ECHO, OPT$CURRENT] = FALSE, !JC [TELNET$K_ECHO, OPT$PREFER] = OPT$STATE_ON, !JC [TELNET$K_ECHO, OPT$ON_RTN] = Set_DEVDEP, !JC [TELNET$K_ECHO, OPT$OFF_RTN] = Set_DEVDEP, !JC [TELNET$K_SUPRGA, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_SUPRGA, OPT$CURRENT] = FALSE, [TELNET$K_SUPRGA, OPT$PREFER] = OPT$STATE_ON, [TELNET$K_Timing_Mark, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_Timing_Mark, OPT$CURRENT] = FALSE, [TELNET$K_Timing_Mark, OPT$ON_RTN] = Timing_Mark_On, [TELNET$K_Timing_Mark, OPT$PREFER] = OPT$DONT_CARE, [TELNET$K_Extended_Ascii, OPT$STATE] = OPT$STATE_OFF,!JC [TELNET$K_Extended_Ascii, OPT$CURRENT] = FALSE, !JC [TELNET$K_Extended_Ascii, OPT$PREFER] = OPT$DONT_CARE,!JC [TELNET$K_Extended_Ascii, OPT$ON_RTN] = Set_DEVDEP, !JC [TELNET$K_Extended_Ascii, OPT$OFF_RTN] = Set_DEVDEP, !JC !!!JC [TELNET$K_Window_Size, OPT$STATE] = OPT$STATE_OFF, !!!JC [TELNET$K_Window_Size, OPT$CURRENT] = FALSE, !!!JC [TELNET$K_Window_Size, OPT$PREFER] = OPT$STATE_ON, !!!JC [TELNET$K_Window_Size, OPT$SUB_RTN] = Window_Size_Sub, [TELNET$K_LineMode, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_LineMode, OPT$CURRENT] = FALSE, [TELNET$K_LineMode, OPT$PREFER] = OPT$STATE_Off), TVT_DEF_REMOTE : OPT$LIST PRESET( [TELNET$K_BINARY, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_BINARY, OPT$CURRENT] = FALSE, [TELNET$K_BINARY, OPT$PREFER] = OPT$DONT_CARE, !!!JC [TELNET$K_ECHO, OPT$STATE] = OPT$STATE_OFF, !JC !!!JC [TELNET$K_ECHO, OPT$CURRENT] = FALSE, !JC !!!JC [TELNET$K_ECHO, OPT$PREFER] = OPT$DONT_CARE, !JC [TELNET$K_SUPRGA, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_SUPRGA, OPT$CURRENT] = FALSE, [TELNET$K_SUPRGA, OPT$PREFER] = OPT$STATE_ON, [TELNET$K_Timing_Mark, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_Timing_Mark, OPT$CURRENT] = FALSE, [TELNET$K_Timing_Mark, OPT$PREFER] = OPT$DONT_CARE, [TELNET$K_Extended_Ascii, OPT$STATE] = OPT$STATE_OFF,!JC [TELNET$K_Extended_Ascii, OPT$CURRENT] = FALSE, !JC [TELNET$K_Extended_Ascii, OPT$PREFER] = OPT$DONT_CARE,!JC [TELNET$K_Terminal_Type, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_Terminal_Type, OPT$CURRENT] = FALSE, [TELNET$K_Terminal_Type, OPT$PREFER] = OPT$STATE_ON, !!! JC [TELNET$K_Terminal_Type, OPT$ON_RTN] = Terminal_Type_On, [TELNET$K_Terminal_Type, OPT$SUB_RTN] = Terminal_Type_Sub, [TELNET$K_Window_Size, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_Window_Size, OPT$CURRENT] = FALSE, [TELNET$K_Window_Size, OPT$PREFER] = OPT$STATE_ON, !!! JC [TELNET$K_Window_Size, OPT$ON_RTN] = Window_Size_On, [TELNET$K_Window_Size, OPT$SUB_RTN] = Window_Size_Sub, [TELNET$K_Toggle_Flow_Control, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_Toggle_Flow_Control, OPT$CURRENT] = FALSE, [TELNET$K_Toggle_Flow_Control, OPT$PREFER] = OPT$STATE_ON, [TELNET$K_LineMode, OPT$STATE] = OPT$STATE_OFF, [TELNET$K_LineMode, OPT$CURRENT] = FALSE, [TELNET$K_LineMode, OPT$PREFER] = OPT$STATE_OFF, [TELNET$K_LineMode, OPT$SUB_RTN] = LineMode_Sub); %SBTTL 'TELNET_CREATE - Initialize a TCP connection for a TVT' %( Creates and initializes a TCB for a new TVT connection. Called from segment input processor when a SYN segment has been received for the well-known TELNET port (WKS$TELNET). )% FORWARD ROUTINE TELNET_OPEN_TIMEOUT : NOVALUE; GLOBAL ROUTINE TELNET_CREATE(LHOST,LPORT,FHOST,FPORT) = BEGIN LOCAL TCB : REF TCB_STRUCTURE, CIDX; ! Check for unique connection. We actually know that the connection is already ! unique, but we do this for the side effect of being inserted in the CONECT ! table. NOINT; IF Check_Unique_Conn(.LPORT,.FHOST,.FPORT,CIDX) NEQ TRUE THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT create failed - CONECT table full!/',0); OKINT; RETURN 0; END; ! Create and initialize a new TCB IF (TCB = TCB$Create()) EQL Error THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT TCB creation failed!/',0); OKINT; RETURN 0; END; ! Perform standard TCB initializations TCP$TCB_Init(.TCB); ! Setup standard TVT TCB fields. Note that segment input processing code will ! setup wild foreign host/port and local host when this routine returns. TCB[IS_TVT] = TRUE; ! This is a TVT TCB[TVTDATA] = 0; ! No TVT data block yet TCB[Local_Host] = .LHOST; ! Set local host and port TCB[Local_Port] = .LPORT; TCB[Foreign_Host] = .FHOST; ! Set foreign host and port TCB[Foreign_Port] = .FPORT; TCB[UCB_ADRS] = 0; ! No UCB for this, since no user process TCB[STATE] = CS$LISTEN; ! Initial state is listening for SYN TCB[CON_INDEX] = .CIDX; Conect_Insert(.TCB,.CIDX); ! Insert into connection table ! Setup a handler if the open times-out TCB[Pending_IO] = TRUE; TCB[Curr_User_Function] = M$INTERNAL; TCB[Timeout_Routine] = TELNET_OPEN_TIMEOUT; TCB[Function_Timer] = Time_Stamp() + TVT_Open_Timeout; ! And return the TCB address OKINT; RETURN .TCB; END; ROUTINE TELNET_OPEN_TIMEOUT(TCB) : NOVALUE = BEGIN ! ! Come here from user function timeout code if a TVT connection does not ! become established soon enough after we first see the SYN for it. We ! simply flush the TCB. ! MAP TCB : REF TCB_STRUCTURE; !~~~ Maybe we should do something better here? XLOG$FAO(LOG$TCPERR,'!%T TVT open timeout for TCB x!XL!/',0,.TCB); TCB$Delete(.TCB); END; %SBTTL 'TELNET_OPEN - Finish open of TCP connection for a TVT' %( Finish setup of TELNET connection, creating TVT data block within the TCB and performing assigmnent/initialization of the pseudo-terminal device associated with this connection. Called from segment input handler when TCP connection goes into the ESTABLISHED state. )% FORWARD ROUTINE TVT_NEGOTIATE : NOVALUE, TCP_READ : NOVALUE, TCP_ADD_STRING : NOVALUE, TCP_WRITE : NOVALUE, PTY_READ : NOVALUE, PTY_WRITE : NOVALUE, NET_TO_PTY : NOVALUE, PTY_TO_NET : NOVALUE, MBX_READ, MBX_READ_DONE : NOVALUE; ROUTINE namelook_done(tvt,rc,namlen,name) : NOVALUE = !+ ! Fills in the name of the remote port !- BEGIN MAP TVT : REF TVT$BLOCK; LOCAL TCB : REF TCB_STRUCTURE, nambuf : VECTOR[100,BYTE], nam : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = %ALLOCATION(nambuf), [DSC$B_DTYPE] = DSC$K_DTYPE_Z, [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = nambuf), accporbuf : VECTOR[100,BYTE], accpornam : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = %ALLOCATION(accporbuf), [DSC$B_DTYPE] = DSC$K_DTYPE_Z, [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = accporbuf); IF (NOT .RC) THEN RETURN; TCB = .TVT[TVT$TCB]; ! get TCB IF $TRNLOG( ! JC Get logical LOGNAM=%ASCID'TELNET_PASS_PORT', ! Pass on port number RSLLEN=nam[DSC$W_LENGTH], ! JC RSLBUF=nam) ! JC EQL SS$_Normal THEN RC = $FAO(%ASCID'!AF!AS!UL', accpornam[DSC$W_LENGTH],accpornam, .namlen,.name, nam, .TCB[Foreign_PORT] ) ELSE RC = $FAO(%ASCID'!AF', accpornam[DSC$W_LENGTH],accpornam, .namlen,.name ); XLOG$FAO(LOG$TELNET ,'!%T Namelook_done: Access port=!AS!/',0 ,accpornam); ! ! It is better to have the correct name than a truncated on ! IF .accpornam[DSC$W_LENGTH] GTR 30 THEN RETURN(SS$_NORMAL); ! JC IF too long skip it !!!JC accpornam[DSC$W_LENGTH] = 30; IF .RC THEN RC = $QIOW (CHAN=.TVT[TVT$PTY_CHN],FUNC=IO$_SETMODE, P1=.accpornam[DSC$A_POINTER], ! Buffer P2=.accpornam[DSC$W_LENGTH], ! Size P4=4 ! Sub-func #4 ); END; GLOBAL ROUTINE TELNET_OPEN(TCB) = BEGIN EXTERNAL ROUTINE LIB$GET_VM_PAGE : BLISS ADDRESSING_MODE(GENERAL), LIB$ASN_WTH_MBX : BLISS ADDRESSING_MODE(GENERAL), LIB$GETDVI : BLISS ADDRESSING_MODE(GENERAL), Print, Line_Changed_AST; EXTERNAL ROUTINE NML$GETNAME; MAP TCB : REF TCB_STRUCTURE; LOCAL nambuf : VECTOR[256,BYTE], nam : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = %ALLOCATION(nambuf), [DSC$B_DTYPE] = DSC$K_DTYPE_Z, [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = nambuf), accporbuf : VECTOR[100,BYTE], accpornam : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = %ALLOCATION(accporbuf), [DSC$B_DTYPE] = DSC$K_DTYPE_Z, [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = accporbuf), TVT : REF TVT$BLOCK, PTYCHAN, MBXCHAN, Status, RC, IO_STATS : BLOCK[8,BYTE], tmp : SIGNED LONG, TMPBUF : BLOCK[TVT_TTY_BUFLEN, BYTE], TMPDSC : BLOCK[DSC$K_Z_BLN,BYTE]; ! Clear the pending open that we were waiting for. TCB[Pending_IO] = FALSE; ! Assign a chunk of memory for the TVT data block ! RC = LIB$GET_VM(%REF(TVT$SIZE*4),TVT); RC = LIB$GET_VM_PAGE(%REF(((TVT$SIZE * 4) / 512) + 1),TVT); IF NOT .RC THEN BEGIN !~~~ Should we do anything better here? XLOG$FAO(LOG$TCPERR, '!%T Telnet_Open: LIB$GET_VM_PAGE failure for TCB=x!XL, RC=x!XL!/' ,0,.TCB,.RC); TCB$DELETE(.TCB); RETURN FALSE; END; ! Clear out the TVT data block CH$FILL(0,TVT$SIZE*4,CH$PTR(.TVT)); TVT[TVT$TCB] = .TCB; ! Initialize the options block to the standard initial state CH$MOVE(OPT$LSTBLEN,CH$PTR(TVT_DEF_LOCAL),CH$PTR(TVT[TVT$LCLOPTS])); CH$MOVE(OPT$LSTBLEN,CH$PTR(TVT_DEF_REMOTE),CH$PTR(TVT[TVT$REMOPTS])); ! Assign the PTY device and start it up. RC = LIB$ASN_WTH_MBX(PTY_NAME, %REF(TVT_MBX_BUFLEN), %REF(TVT_MBX_BUFLEN), PTYCHAN, MBXCHAN); IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR, '!%T Telnet_Open: PTY assign failure for TCB x!XL, RC=x!XL!/' ,0,.TCB,.RC); TCB$DELETE(.TCB); RETURN FALSE; END; ! Associate the TVT with the TCP connection TVT[TVT$PTY_CHN] = .PTYCHAN; TVT[TVT$MBX_CHN] = .MBXCHAN; TCB[TVTDATA] = .TVT; ! Fill in the access port as [n.n.n.n] IF $TRNLOG( ! JC Get logical LOGNAM=%ASCID'TELNET_PASS_PORT', ! Pass on port number RSLLEN=nam[DSC$W_LENGTH], ! JC RSLBUF=nam) ! JC EQL SS$_Normal THEN ! JC If got it RC = $FAO(%ASCID'!UB.!UB.!UB.!UB!AS!UL', accpornam[DSC$W_LENGTH],accpornam, .(TCB[Foreign_Host])< 0,8,0>, .(TCB[Foreign_Host])< 8,8,0>, .(TCB[Foreign_Host])<16,8,0>, .(TCB[Foreign_Host])<24,8,0>, nam, .TCB[Foreign_PORT] ) ELSE RC = $FAO(%ASCID'!UB.!UB.!UB.!UB', accpornam[DSC$W_LENGTH],accpornam, .(TCB[Foreign_Host])< 0,8,0>, .(TCB[Foreign_Host])< 8,8,0>, .(TCB[Foreign_Host])<16,8,0>, .(TCB[Foreign_Host])<24,8,0> ); XLOG$FAO(LOG$TELNET ,'!%T Telnet_Open: Remote host=!AS!/',0 ,accpornam); IF .accpornam[DSC$W_LENGTH] GTR 30 THEN ! IF too long accpornam[DSC$W_LENGTH] = 30; ! Adjust it IF .RC THEN RC = $QIOW (CHAN=.TVT[TVT$PTY_CHN],FUNC=IO$_SETMODE, P1=.accpornam[DSC$A_POINTER], ! Buffer P2=.accpornam[DSC$W_LENGTH], ! Size P4=4 ! Sub-func #4 ); ! Fill in the actual name after name resolution NML$GETNAME(.TCB[Foreign_Host], namelook_done, .TVT); ! Start a receive on the PTY mailbox. IF NOT MBX_READ(.TVT) THEN BEGIN TCB$DELETE(.TCB); RETURN FALSE; END; ! Initialize buffer pointers TVT[TVT$RD_PTR] = CH$PTR(TVT[TVT$RD_BUF]); ! TVT[TVT$WR_PTR] = CH$PTR(TVT[TVT$WR_BUF]); TVT[TVT$WR_IPTR] = 0 ; TVT[TVT$WR_OPTR] = 0 ; TVT[TVT$NEG_EQP] = TVT[TVT$NEG_DQP] = CH$PTR(TVT[TVT$NEG_BUF]); TVT[TVT$WR_ICNT] = 0 ; TVT[TVT$WR_OCNT] = 0 ; ! ! Create a banner to send to the user ! The banner is contained in logical TELNET_ANNOUNCE JC ! TMPDSC[DSC$B_CLASS] = DSC$K_CLASS_Z; TMPDSC[DSC$B_DTYPE] = DSC$K_DTYPE_Z; TMPDSC[DSC$W_LENGTH] = %ALLOCATION(TMPBUF); TMPDSC[DSC$A_POINTER] = TMPBUF; ! $FAO(%ASCID'!/!AS VAX/VMS (CMU) TELNET Service!/', ! TMPDSC[DSC$W_LENGTH], TMPDSC, LOCAL_NAME); NAM [DSC$W_LENGTH] = %ALLOCATION(nambuf); IF $TRNLOG( ! JC Get logical LOGNAM=%ASCID'TELNET_ANNOUNCE', ! JC name for banner RSLLEN=nam[DSC$W_LENGTH], ! JC RSLBUF=nam) ! JC EQL SS$_Normal THEN ! JC If got it BEGIN $FAO(%ASCID'!AS!/' ! JC Put into output ,TMPDSC[DSC$W_LENGTH] ! JC buffer ,TMPDSC ! JC ,NAM); ! JC TCP_Add_String(.TVT, TMPDSC) ; END ; ! Check for creation of terminal side of connection (like _TZA0:) ! when ever we get input, until this flag is cleared. TVT[TVT$DO_PID] = 1; ! Stuff the initial into the PTY buffer for JOBCTL ! CH$WCHAR(%CHAR(0),CH$PTR(TVT[TVT$WR_BUF])); NET_TO_PTY(.TVT, CH_NUL) ; ! Queue up the options that we want TVT_NEGOTIATE(.TVT); ! Write the buffered data to the PTY and to the network ! We assume here that the initial banner can always fit in the network queue. TCP_WRITE(.TVT); PTY_WRITE(.TVT); PTY_READ(.TVT); ! And give success return. TRUE END; %SBTTL 'TELNET_CLOSE - Handle close of TELNET connection' %( Handle normal close of TELNET connection. Flush the TVT data structure. Called from TCB$Delete just before TCB is deallocated. )% FORWARD ROUTINE TELNET_CLOSE_DONE : NOVALUE; GLOBAL ROUTINE TELNET_CLOSE(TCB) : NOVALUE = BEGIN MAP TCB : REF TCB_STRUCTURE; EXTERNAL ROUTINE NML$CANCEL; LOCAL FHOST : INITIAL(.TCB[Foreign_Host]), FPORT : INITIAL(.TCB[Foreign_Port]), TVT : REF TVT$BLOCK; ! Log this. XLOG$FAO(LOG$TCBSTATE,'!%T TVT TCB x!XL closing, TVT=x!XL!/', 0,.TCB,.TCB[TVTDATA]); ACT$FAO('!%D Telnet-in closed to IP addr !UB.!UB.!UB.!UB port=!UW!/',0, .FHOST<0,8>,.FHOST<8,8>,.FHOST<16,8>,.FHOST<24,8>, .FPORT); ! Make sure we have a TVT and it isn't already being cancelled. TVT = .TCB[TVTDATA]; IF (.TVT NEQ 0) AND (NOT .TVT[TVT$CANCEL]) THEN BEGIN ! Deassign the PTY and mailbox channels. NML$CANCEL(.TVT,0,0); ! Cancel the name lookup for accpornam NOINT; TVT[TVT$CANCEL] = TRUE; $DASSGN(CHAN = .TVT[TVT$PTY_CHN]); $DASSGN(CHAN = .TVT[TVT$MBX_CHN]); $DCLAST(ASTADR = TELNET_CLOSE_DONE, ASTPRM = .TVT); OKINT; END; END; ROUTINE TELNET_CLOSE_DONE(TVT) : NOVALUE = ! ! Finish deallocation of a TVT, after all AST's have been delivered. ! BEGIN MAP TVT : REF TVT$BLOCK; EXTERNAL ROUTINE LIB$FREE_VM : BLISS ADDRESSING_MODE(GENERAL), LIB$FREE_VM_PAGE : BLISS ADDRESSING_MODE(GENERAL); ! Just deallocate the TVT structure and return. ! LIB$FREE_VM(%REF(TVT$SIZE*4),TVT); LIB$FREE_VM_PAGE(%REF(((TVT$SIZE * 4) / 512) + 1),TVT); END; %SBTTL 'TELNET_INPUT - Do TCP input for TELNET connection' %( Process incoming network data for a TELNET connection, handling any necessary option negotiations and passing any user data to the PTY associated with this connection. Called from segment input handler when TCP receive window becomes non-empty. )% GLOBAL ROUTINE TELNET_INPUT(TCB) : NOVALUE = BEGIN MAP TCB : REF TCB_STRUCTURE; ! Call TCP input routine %IF USE_ASTS %THEN $DCLAST(ASTADR = PTY_WRITE, ASTPRM = .TCB[TVTDATA]); %ELSE PTY_WRITE(.TCB[TVTDATA]); %FI END; %SBTTL 'TELNET_OUTPUT - Do TCP output for TELNET connection' %( Obtain some data to output to the network whenever the TCP send queue becomes non-empty. Normally, the PTY read done AST will put data onto the TCP output queue (via TCP_WRITE) whenever it arrives over the PTY. When the queue fills, however, it effectively 'blocks', without issuing further PTY reads, until the queue becomes non-full (i.e. the send window opens). )% GLOBAL ROUTINE TELNET_OUTPUT(TCB) : NOVALUE = BEGIN MAP TCB : REF TCB_STRUCTURE; ! Just call TCP write with the TVT's TCB %IF USE_ASTS %THEN $DCLAST(ASTADR = PTY_READ, ASTPRM = .TCB[TVTDATA]); %ELSE PTY_READ(.TCB[TVTDATA]); %FI END; %SBTTL 'Routines to interface to the network' FORWARD ROUTINE TVT_READ_WILL : NOVALUE, TVT_READ_WONT : NOVALUE, TVT_READ_DO : NOVALUE, TVT_READ_DONT : NOVALUE, TVT_READ_SUB : NOVALUE ; ROUTINE TCP_READ(TVT) : NOVALUE = ! ! TCP_READ - Read as much data as possible from the network into the PTY write ! buffer. If no write is yet in progress, start a write now. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND LCLOPTS = TVT[TVT$LCLOPTS] : OPT$LIST ; EXTERNAL ROUTINE IS_CNTRLT_GOOD; LOCAL TCB : REF TCB_STRUCTURE, Byte_Count, Byte_Limit, Prev_Char, CHRPTR, CHRCNT, CHWPTR, CHR, NEGCNT ; LABEL X; ! Empty out PTY, so we can accept more input ! PTY_READ(.TVT) ; ! If the PTY write buffer is busy, then don't run here. IF .TVT[TVT$PWRITE] THEN RETURN; ! Is there any data to write? TCB = .TVT[TVT$TCB]; IF .TCB[RCV_Q_COUNT] LEQ 0 THEN RETURN; ! If already doing a net read, then don't run here. IF .TVT[TVT$NREAD] THEN RETURN; ! Indicate that we're doing a network read TVT[TVT$NREAD] = TRUE; NEGCNT = .TVT[TVT$NEG_CNT]; ! We have some data to write. Copy from network to the PTY buffer ! N.B. Need to be careful of synchonization problem with CQ_xxx routines. CHRCNT = .TCB[RCV_Q_COUNT]; CHRPTR = .TCB[RCV_Q_DEQP]; ! CHWPTR = .TVT[TVT$WR_PTR]; ! = CH$PTR(TVT[TVT$WR_BUF]); Byte_Limit = MIN(.CHRCNT, (TVT_TTY_BUFLEN - .TVT[TVT$WR_BCNT])) ; CHR = CH_NUL ; ! Check to see if there is enough buffer space remaining ! IF (.TVT[TVT$WR_BCNT] GEQ (TVT_TTY_BUFLEN - PTY_BUFFER_SIZE)) THEN IF (.TVT[TVT$WR_BCNT] GEQ (TVT_TTY_BUFLEN - 2)) THEN BEGIN TVT[TVT$GAG] = TRUE ; END ELSE BEGIN TVT[TVT$GAG] = FALSE ; END ; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL TCP_READ: CHRCNT = !SL, BCNT = !SL limit = !SL!/', 0, .TVT[TVT$TCB], .CHRCNT, .TVT[TVT$WR_BCNT], .Byte_Limit) ; END; TVT[TVT$CTRL] = FALSE ; ! WHILE ((.CHRCNT GTR 0) AND (.TVT[TVT$WR_BCNT] LEQ (TVT_TTY_BUFLEN - 1))) DO ! WHILE ((.CHRCNT GTR 0) AND (NOT .TVT[TVT$GAG])) DO WHILE ((.Byte_Limit GTR 0) AND (NOT .TVT[TVT$GAG])) DO BEGIN ! Read another character from the network buffer, wrapping pointer as needed Prev_Char = .CHR ; CHR = CH$RCHAR_A(CHRPTR); IF .CHRPTR GEQ .TCB[RCV_Q_END] THEN CHRPTR = .TCB[RCV_Q_BASE]; CHRCNT = .CHRCNT - 1; Byte_Limit = .Byte_Limit - 1 ; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL TCP_READ: CHRCNT = !SL, BCNT = !SL limit = !SL CHR = x!XB!/', 0, .TVT[TVT$TCB], .CHRCNT, .TVT[TVT$WR_BCNT], .Byte_Limit, .CHR) ; END; ! Handle this character based on the current state CASE .TVT[TVT$NRSTATE] FROM TVT$STATE_MIN TO TVT$STATE_MAX OF SET [TVT$STATE_NORMAL]: ! Normal state X: BEGIN IF .CHR EQL TELNET$K_IAC THEN BEGIN ! Have an IAC - enter IAC state. TVT[TVT$NRSTATE] = TVT$STATE_IAC; LEAVE X; END; ! If reading subnegotiation string, then append byte to subnegotiation buffer IF .TVT[TVT$NR_SB] THEN BEGIN IF .TVT[TVT$SUB_CNT] LSS TVT_SUB_BUFLEN THEN BEGIN CH$WCHAR_A(.CHR,TVT[TVT$SUB_PTR]); TVT[TVT$SUB_CNT] = .TVT[TVT$SUB_CNT] + 1 END; LEAVE X; END; ! If we're in BINARY mode, just output the character IF .LCLOPTS[TELNET$K_BINARY,OPT$STATE] THEN BEGIN Net_To_PTY(.TVT, .CHR) ; END ELSE BEGIN ! For non BINARY mode, check for special processing following CR IF .TVT[TVT$NR_CR] THEN BEGIN ! If we had a CR as the last character, then do special processing of char SELECTONE .CHR OF SET [CH_NUL]: ! Null - fake a LF BEGIN !!!HWM Net_To_PTY(.TVT, CH_LF) ; TVT[TVT$NR_CR] = FALSE; END; [CH_CR]: ! Another CR - append it & retain CR state BEGIN Net_To_PTY(.TVT, .CHR) ; END; [CH_LF]: ! LF after CR - drop LF and reset CR state BEGIN !~~~ This code actually violates RFC 854, but is necessary to deal with many !~~~ shithead UNIX systems which send CR-LF-LF when the user types CR-LF. !~~~ We should be keeping the LF here. !~~~ (We are, now. HWM 4-Nov-91) !!! Net_To_PTY(.TVT, .CHR) ; TVT[TVT$NR_CR] = FALSE; TVT[TVT$NR_LF] = TRUE ; END; [OTHERWISE]: ! Funny state - append and reset CR state BEGIN Net_To_PTY(.TVT, .CHR) ; TVT[TVT$NR_CR] = FALSE; TVT[TVT$NR_LF] = FALSE ; END; TES; END ELSE BEGIN !!! Didn't have a previous CR. Check for LF now and prepend a CR !!!JC IF .CHR EQL CH_LF THEN !!!JC BEGIN !!!JC TVT[TVT$NR_LF] = TRUE ; !!!JC !!!HWM Net_To_PTY(.TVT, CH_CR) ; !!!JC IF $$LOGF(LOG$TVT) THEN !!!JC BEGIN !!!JC LOG$FAO('!%T TCB x!XL TCP_READ: ADD CR, BCNT = !SL!/', !!!JC 0, .TVT[TVT$TCB], .TVT[TVT$WR_BCNT]) ; !!!JC END; !!!JC END ; ! Didn't have a previous CR. Check for one now and output the byte. IF .CHR EQL CH_CR THEN BEGIN TVT[TVT$NR_CR] = TRUE ; TVT[TVT$NR_LF] = FALSE ; END ; Net_To_PTY(.TVT, .CHR) ; END; END; END; [TVT$STATE_IAC]: ! IAC - Start negotiation BEGIN ! Select the different types of negotiations XLOG$FAO(LOG$TELNEG,'!%T Negotiate !UB/',0,.CHR); SELECTONE .CHR OF SET [TELNET$K_IAC]: ! Another IAC. Send one IAC to terminal BEGIN Net_To_PTY(.TVT, .CHR) ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [TELNET$K_WILL]: ! Remote WILL handle an option TVT[TVT$NRSTATE] = TVT$STATE_WILL; [TELNET$K_WONT]: ! Remote WONT handle an option TVT[TVT$NRSTATE] = TVT$STATE_WONT; [TELNET$K_DO]: ! Remote tells us DO an option TVT[TVT$NRSTATE] = TVT$STATE_DO; [TELNET$K_DONT]: ! Remote tells us DONT do an option TVT[TVT$NRSTATE] = TVT$STATE_DONT; [TELNET$K_SB]: ! Remote is starting subnegotiation BEGIN TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; TVT[TVT$NR_SB] = TRUE; TVT[TVT$SUB_PTR] = TVT[TVT$SUB_BUF]; TVT[TVT$SUB_CNT] = 0; END; [TELNET$K_SE]: ! Remote is finished with subnegotiation BEGIN TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; TVT[TVT$NR_SB] = FALSE; TVT[TVT$SUB_PTR] = TVT[TVT$SUB_BUF]; TVT_READ_SUB(.TVT) END; [TELNET$K_AYT]: ! User is nervous. Comfort them. BEGIN IF NOT IS_CNTRLT_GOOD(.TVT) THEN BEGIN TCP_ADD_STRING(.TVT,AYT_RESPONSE); END ; Net_To_PTY(.TVT, Telnet$K_Char_AYT) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL END; [TELNET$K_Brk]: ! I think VMS ignores the break key. BEGIN Net_To_PTY(.TVT, Telnet$K_Char_Brk) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL END; [TELNET$K_IP]: ! Interrupt process BEGIN Net_To_PTY(.TVT, Telnet$K_Char_IP) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL END; [TELNET$K_AO]: ! Abort Output BEGIN Net_To_PTY(.TVT, Telnet$K_Char_AO) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [TELNET$K_EC]: ! Erase Character BEGIN Net_To_PTY(.TVT, Telnet$K_Char_EC) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [TELNET$K_EL]: ! Erase Line BEGIN Net_To_PTY(.TVT, Telnet$K_Char_EL) ; TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [TELNET$K_EOR]: ! End of Record BEGIN Net_To_PTY(.TVT, CH_CR) ; ! Fake it by stuffing a CR TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [TELNET$K_Data_Mark]: ! Data Mark BEGIN Net_To_PTY(.TVT, Telnet$K_Char_PURGE) ; ! Purge typeahead TVT[TVT$CTRL] = TRUE ; TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; [OTHERWISE]: ! Garbage to us BEGIN XLOG$FAO(LOG$TELNEG,'!%T Garbage !UB/',0,.CHR); TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; END; TES; END; [TVT$STATE_WILL]: ! Process the WILL according to option state TVT_READ_WILL(.TVT,.CHR); [TVT$STATE_WONT]: ! Process the WONT TVT_READ_WONT(.TVT,.CHR); [TVT$STATE_DO]: ! Process the DO TVT_READ_DO(.TVT,.CHR); [TVT$STATE_DONT]: ! Process the DONT TVT_READ_DONT(.TVT,.CHR); [INRANGE,OUTRANGE]: ! Shouldn't ever get here. 0; TES; !~~~ Update receive window information. TCB[RCV_WND] = .TCB[RCV_WND] + 1 ; TCB[PENDING_ACK] = TRUE; ! Update network receive queue pointer and count. TCB[RCV_Q_DEQP] = .CHRPTR; TCB[RCV_Q_COUNT] = .TCB[RCV_Q_COUNT] - 1 ; IF (.TVT[TVT$CTRL]) THEN EXITLOOP ; END; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL TCP_READ: BCNT = !SL!/', 0, .TVT[TVT$TCB], .TVT[TVT$WR_BCNT]) ; END; ! Indicate that we're no longer doing a network read TVT[TVT$NREAD] = FALSE; ! If we moved some data, then force a ACK now IF (.TCB[PENDING_ACK]) THEN BEGIN TCP$Enqueue_Ack(.TCB) ; END ; END; ROUTINE PTY_TO_NET(TVT, CHR) : NOVALUE = ! ! PTY_TO_NET - Write a byte of data as to the network buffer. ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL TCB : REF TCB_STRUCTURE, CHWMAX, CHWCNT, CHWPTR ; ! Make sure there is some room in the network output queue TCB = .TVT[TVT$TCB]; CHWMAX = .TCB[SND_Q_SIZE]-.TCB[SND_Q_COUNT]-.TCB[SRX_Q_COUNT]; ! IF $$LOGF(LOG$TVT) THEN ! BEGIN ! LOG$FAO('!%T TCB x!XL PTY_TO_NET: CHWMAX = !SL!/', ! 0, .TVT[TVT$TCB], .CHWMAX) ; ! END; IF .CHWMAX LEQ 0 THEN RETURN; ! If already doing a net write, then don't run here. IF .TVT[TVT$NWRITE] THEN RETURN; ! Indicate that we have a write in progress TVT[TVT$NWRITE] = TRUE; ! Copy bytes from the PTY read buffer to the network, quoting IAC's as needed. CHWCNT = 0; CHWPTR = CH$PTR(.TCB[SND_Q_ENQP]); ! Write a character to the output buffer, taking care to wrap the pointer CH$WCHAR_A(.CHR,CHWPTR); IF .CHWPTR GEQU .TCB[SND_Q_END] THEN CHWPTR = .TCB[SND_Q_BASE]; ! Update the network queue pointer and counter TCB[SND_Q_ENQP] = .CHWPTR; TCB[SND_Q_COUNT] = .TCB[SND_Q_COUNT] + 1 ; TCB[SND_PPTR] = .TCB[SND_NXT] + .TCB[SND_Q_COUNT]; TCB[SND_PUSH_FLAG] = TRUE; ! If the send queue just became nonempty, then schedule a wakeup so that this ! TCB will be serviced soon. ! IF .TCB[SND_Q_COUNT] EQL .CHWCNT THEN IF .TCB[SND_Q_COUNT] EQL .TCB[MAX_EFF_DATA_SIZE] THEN $ACPWAKE; ! Indicate that we're not in the network write code any more TVT[TVT$NWRITE] = FALSE; END; ROUTINE TCP_WRITE(TVT) : NOVALUE = ! ! TCP_WRITE - Write as much data as possible from the PTY read buffer to the ! network. ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL TCB : REF TCB_STRUCTURE, Now : UNSIGNED, CHWMAX, CHWCNT, CHWPTR, CHR; ! Make sure there is some room in the network output queue TCB = .TVT[TVT$TCB]; CHWMAX = .TCB[SND_Q_SIZE]-.TCB[SND_Q_COUNT]-.TCB[SRX_Q_COUNT]; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB !XL TCP_WRITE: CHWMAX = !SL NWRITE=!UB!/', 0, .TVT[TVT$TCB], .CHWMAX, .TVT[TVT$NWRITE]) ; END; IF .CHWMAX LEQ 0 THEN BEGIN ! Something got jammed - gotta force a write ! TCP$Send_Data(.TCB) ; $ACPWAKE ; RETURN; END ; ! If already doing a net write, then don't run here. IF .TVT[TVT$NWRITE] THEN RETURN; ! Indicate that we have a write in progress TVT[TVT$NWRITE] = TRUE; ! Copy bytes from the PTY read buffer to the network, quoting IAC's as needed. CHWCNT = 0; CHWPTR = CH$PTR(.TCB[SND_Q_ENQP]); WHILE TRUE DO BEGIN ! Do we need to send a doubled IAC? IF .TVT[TVT$NW_IAC] THEN BEGIN CHR = TELNET$K_IAC; TVT[TVT$NW_IAC] = FALSE; END ELSE BEGIN ! If there are negotiation bytes to send, then do them first. IF .TVT[TVT$NEG_CNT] NEQU 0 THEN BEGIN ! Get next byte from negotiation buffer and send to net CHR = CH$RCHAR_A(TVT[TVT$NEG_DQP]); IF (TVT[TVT$NEG_CNT] = .TVT[TVT$NEG_CNT]-1) EQL 0 THEN TVT[TVT$NEG_DQP] = CH$PTR(TVT[TVT$NEG_BUF]); END ELSE BEGIN ! Get a character and check for an IAC that needs to be quoted IF .TVT[TVT$RD_BCNT] LEQ 0 THEN EXITLOOP; CHR = CH$RCHAR_A(TVT[TVT$RD_PTR]); IF .CHR EQL TELNET$K_IAC THEN TVT[TVT$NW_IAC] = TRUE; TVT[TVT$RD_BCNT] = .TVT[TVT$RD_BCNT] - 1; END; END; ! Write a character to the output buffer, taking care to wrap the pointer CH$WCHAR_A(.CHR,CHWPTR); IF .CHWPTR GEQU .TCB[SND_Q_END] THEN CHWPTR = .TCB[SND_Q_BASE]; IF (CHWCNT = .CHWCNT + 1) GEQ .CHWMAX THEN EXITLOOP; END; ! Update the network queue pointer and counter TCB[SND_Q_ENQP] = .CHWPTR; TCB[SND_Q_COUNT] = .TCB[SND_Q_COUNT] + .CHWCNT; TCB[SND_PPTR] = .TCB[SND_NXT] + .TCB[SND_Q_COUNT]; TCB[SND_PUSH_FLAG] = TRUE; ! If the send queue just became nonempty, then schedule a wakeup so that this ! TCB will be serviced soon. Now = Time_Stamp() ; IF $$LOGF(LOG$TVT OR LOG$TCP) THEN BEGIN LOG$FAO('!%T TCB !XL TCP_WRITE: SNDQCNT= !SL SRXQCNT=!SL!/', 0, .TVT[TVT$TCB], .TCB[SND_Q_COUNT], .TCB[SRX_Q_COUNT]) ; LOG$FAO('!%T TCB !XL TCP_WRITE: NOW= !SL Delay=!SL!/', 0, .TVT[TVT$TCB], .Now, .TCB[SND_Delay_Timer]) ; END; ! IF .TCB[SND_Q_COUNT] EQL .CHWCNT THEN IF (((.TCB[SND_Q_COUNT] + .TCB[SRX_Q_COUNT]) GEQ .TCB[MAX_EFF_DATA_SIZE]) OR (.Now GEQU .TCB[SND_Delay_Timer])) THEN $ACPWAKE; ! TCP$Send_Data(.TCB) ; ! Indicate that we're not in the network write code any more TVT[TVT$NWRITE] = FALSE; END; ROUTINE TCP_ADD_STRING(TVT,STRDESC_A) : NOVALUE = ! ! TCP_ADD_STRING - Write as much data as possible from the supplied string ! to the network write buffer via PTY_TO_NET. ! BEGIN BIND STRDESC = .STRDESC_A : $BBLOCK; MAP TVT : REF TVT$BLOCK; LOCAL TCB : REF TCB_STRUCTURE, CHWMAX, CHWCNT, CHWPTR, CHRCNT, CHRPTR, CHR; CHRCNT = .STRDESC[DSC$W_LENGTH]; CHRPTR = CH$PTR(.STRDESC[DSC$A_POINTER]); IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB !XL TCP_ADD_STRING: CNT !UL STR !AS!/', 0, .TVT[TVT$TCB], .CHRCNT, STRDESC) ; END; ! Make sure there is some room in the PTY read queue IF .TVT[TVT$RD_BCNT] GEQ (TVT_TTY_BUFLEN-.CHRCNT) THEN RETURN; CHWPTR = TVT[TVT$RD_PTR] = CH$PTR(TVT[TVT$RD_BUF]); WHILE (.CHRCNT GTR 0) DO BEGIN CHR = CH$RCHAR_A(CHRPTR); PTY_TO_NET(.TVT, .CHR) ; CHRCNT = .CHRCNT - 1; END; END; ROUTINE NET_TO_PTY(TVT, CHR) : NOVALUE = ! ! NET_TO_PTY - Move a byte from the net buffer to PTY buffer and force a ! write, if possible ! BEGIN MAP TVT : REF TVT$BLOCK; BIND IO_Status = TVT[TVT$WR_IOSB] : PTY$IOSB ; LOCAL Byte_Count, Bytes_Remaining, TT_WR_PTR, RC; ! Empty PTY buffers ! PTY_READ(.TVT) ; ! Check to see if there is enough buffer space remaining ! IF (.TVT[TVT$WR_BCNT] GEQ (TVT_TTY_BUFLEN - PTY_BUFFER_SIZE)) THEN IF (.TVT[TVT$WR_BCNT] GEQ (TVT_TTY_BUFLEN - 2)) THEN BEGIN TVT[TVT$GAG] = TRUE ; END ELSE BEGIN TVT[TVT$GAG] = FALSE ; END ; IF (.TVT[TVT$WR_BCNT] GEQ (TVT_TTY_BUFLEN - 1)) THEN BEGIN IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL NET_TO_PTY: CHR = x!XB, PTY Buffer full!/', 0, .TVT[TVT$TCB], .CHR) ; END; RETURN ; END ; ! Stuff character in PTY write buffer, update pointers TT_WR_PTR = CH$PTR(TVT[TVT$WR_BUF], .TVT[TVT$WR_IPTR]) ; CH$WCHAR_A(.CHR, TT_WR_PTR) ; TVT[TVT$WR_ICNT] = .TVT[TVT$WR_ICNT] + 1 ; TVT[TVT$WR_BCNT] = .TVT[TVT$WR_BCNT] + 1 ; TVT[TVT$WR_IPTR] = .TVT[TVT$WR_IPTR] + 1 ; IF (.TVT[TVT$WR_IPTR] GEQ TVT_TTY_BUFLEN) THEN BEGIN TVT[TVT$WR_IPTR] = 0 ; END ; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL NET_TO_PTY: CHR = x!XB, ICNT = !SL, IPTR = !SL!/', 0, .TVT[TVT$TCB], .CHR, .TVT[TVT$WR_ICNT], .TVT[TVT$WR_IPTR]) ; END; ! Compute realistic byte count Byte_Count = MIN(.TVT[TVT$WR_BCNT], TVT_TTY_BUFLEN) ; ! Do logging... IF $$LOGF(LOG$TVT) THEN BEGIN TT_WR_PTR = CH$PTR(TVT[TVT$WR_BUF], .TVT[TVT$WR_IPTR]) ; LOG$FAO('!%T TCB x!XL NET_TO_PTY: #bytes=!SL, Byte Count = !SL,Data=[!AD]!/', 0,.TVT[TVT$TCB], .TVT[TVT$WR_BCNT], .Byte_Count, TVT_TTY_BUFLEN, TVT[TVT$WR_BUF]); END; END; %SBTTL 'Routines to interface to the PTY' ROUTINE PTY_SET_OWNER_PID(TVT) : NOVALUE = ! ! PTY_SET_OWNER_PID : Fill in the User_ID field of the associated TCB ! by interrogating the appropriate device for the TELNET session. ! ! While we're here, we call POKEADDR to give it the information we would ! like (also to the VMS accounting file). ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL TCB: REF TCB_STRUCTURE, devstr : VECTOR[20,Byte], devnam : $BBLOCK[DSC$K_S_BLN], !!! devsln, ptynambuf : VECTOR[20,BYTE], ptynam : $BBLOCK[DSC$K_S_BLN] PRESET ( [DSC$W_LENGTH] = %ALLOCATION(ptynambuf), [DSC$B_DTYPE] = DSC$K_DTYPE_Z, [DSC$B_CLASS] = DSC$K_CLASS_Z, [DSC$A_POINTER] = ptynambuf), RC, Unit_Number, Owner_PID, Owner_UIC, FHost,FPort, Item_List : $ITMLST_DECL (Items = 3); EXTERNAL ROUTINE PokeAddr : ADDRESSING_MODE(GENERAL); ! point at the TCB for this TVT. TCB = .TVT[TVT$TCB]; FHost = .TCB[Foreign_Host]; ! fill in the owner pid. First get the unit number of the pty device, ! then build a request for the owner pid of the device associated with it. $ITMLST_INIT (ITMLST = Item_List, (ITMCOD = DVI$_UNIT, BUFADR = Unit_Number)); RC = $GETDVIW (ITMLST = Item_List,CHAN=.TVT[TVT$PTY_CHN]); IF .RC THEN BEGIN $ITMLST_INIT(ITMLST = Item_List, (ITMCOD = DVI$_PID, BUFADR = Owner_Pid), (ITMCOD = DVI$_OWNUIC, BUFADR = Owner_UIC)); ! make a descriptor to hold the device name: devnam[DSC$B_DTYPE] = DSC$K_DTYPE_Z; devnam[DSC$B_CLASS] = DSC$K_CLASS_Z; devnam[DSC$W_LENGTH] = %ALLOCATION(devstr); devnam[DSC$A_POINTER] = devstr; ! generate this device name string using $FAO: ptynam[DSC$W_LENGTH] = %ALLOCATION(ptynambuf); RC = $TRNLOG( LOGNAM=%ASCID'INET$PTY_TERM', ! JC RSLLEN=ptynam[DSC$W_LENGTH], ! JC RSLBUF=ptynam); ! JC IF NOT .RC THEN TVT[TVT$DO_PID] = 0; ! Cancel IF .RC EQL SS$_Normal THEN RC = $FAO(%ASCID'_!ASA!UL:',devnam,devnam,ptynam,.Unit_Number); IF .RC THEN RC = $GETDVIW (ITMLST = Item_List, DEVNAM = devnam); xlog$fao(LOG$TELNET,'!%T PTY_Set_owner_PID: TTY_TERM="!AS"!/',0,devnam); ! free the string descriptor, we don't need it any more. ! LIB$FREE_VM(devsln,devstr); ! check return status from the $GETDVIW & $FAO calls. IF .RC AND (.Owner_Pid NEQ 0) THEN BEGIN ! finally, we know the PID, so we can fill in the owner field ! of the appropriate TCB. TCB[User_ID]=.Owner_Pid; TVT[TVT$DO_PID] = 0; ! Also, set up the information in the remote process' ! P1 space... PokeAddr(.Owner_Pid, .TCB[Foreign_Host], .TCB[Foreign_Port]); ! Note the connection in the activity log file. ACT$FAO( '!%D Telnet-in (PID:x!XW UIC:!%U) !/',0, .Owner_PID<0,16,0>, .Owner_UIC, .FHost<0,8>,.FHost<8,8>,.FHost<16,8>,.FHost<24,8>, .TCB[Foreign_Port]); ! ! Now set any delayed device dependent ! Set_DEVDEP(.TVT); ! JC PTY_Write(.TVT); ! JC Write after Hold off END; END; END; FORWARD ROUTINE PTY_READ_DONE : NOVALUE; ROUTINE PTY_READ(TVT) : NOVALUE = ! ! PTY_READ - Initiate a read on the PTY device, if there is room in the PTY ! read buffer. ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL TCB : REF TCB_STRUCTURE, Byte_Count, RC; ! Make sure there is some room in the network output queue TCB = .TVT[TVT$TCB]; Byte_Count = .TCB[SND_Q_SIZE]-.TCB[SND_Q_COUNT]-.TCB[SRX_Q_COUNT]; XLOG$FAO(LOG$TVT, '!%T TVT PTY_read: TCB x!XL, BC=!SL, RDCNT=!SL, NGCNT=!SL!/', 0, .TVT[TVT$TCB], .Byte_Count, .TVT[TVT$RD_BCNT], .TVT[TVT$NEG_CNT]); ! Empty out the TCP buffers IF ((.TVT[TVT$NEG_CNT] GTR 0) OR (.TVT[TVT$RD_BCNT] GTR 0)) THEN BEGIN TCP_WRITE(.TVT) ; END ; ! Ignore this if there is already a PTY read in progress. IF .TVT[TVT$PREAD] THEN RETURN; TVT[TVT$PREAD] = TRUE; ! Compute realistic byte count Byte_Count = MIN(.Byte_Count, TVT_TTY_BUFLEN) ; ! Initiate a read on the PTY device RC = $QIO( CHAN = .TVT[TVT$PTY_CHN], FUNC = IO$_READVBLK, IOSB = TVT[TVT$RD_IOSB], ASTADR = PTY_READ_DONE, ASTPRM = .TVT, P1 = TVT[TVT$RD_BUF], P2 = .Byte_Count); IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR, '!%T TVT PTY read $QIO failure for TCB x!XL, RC=x!XL!/', 0,.TVT[TVT$TCB],.RC); TCB$DELETE(.TVT[TVT$TCB]); END; END; ROUTINE PTY_READ_DONE(TVT) : NOVALUE = ! ! AST routine when PTY read operation finishes. Attempt to write the new data ! to the network, via TCP_WRITE. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND IOSB = TVT[TVT$RD_IOSB] : PTY$IOSB; LOCAL TCB : REF TCB_STRUCTURE, Byte_Count, CHR, RC; ! Make sure the TVT is still valid IF .TVT[TVT$CANCEL] THEN RETURN; ! Check the status of the read. SS$_CANCEL/SS$_ABORT are ignored. RC = .IOSB[PTSB$STATUS]; IF (.RC EQL SS$_CANCEL) OR (.RC EQL SS$_ABORT) THEN RETURN; IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT read error for TCB x!XL, RC=x!XL!/', 0,.TVT[TVT$TCB],.RC); TCB$DELETE(.TVT[TVT$TCB]); RETURN; END; ! AST_IN_PROGRESS = TRUE; NOINT ; ! Clear read-in-progress and set number of bytes read. TVT[TVT$RD_BCNT] = .IOSB[PTSB$NBYTES]; TVT[TVT$RD_PTR] = CH$PTR(TVT[TVT$RD_BUF]); TVT[TVT$PREAD] = FALSE; ! AST_IN_PROGRESS = FALSE; OKINT; ! check the User_ID field of the TCB. IF zero, we want to fill it in ! with the process ID of the connected TELNET session. TCB = .TVT[TVT$TCB]; IF .TVT[TVT$DO_PID] THEN BEGIN !JC ----------------- Kludge ------------------------- ! The followin test is to make sure that we have an initial login prompt ! This assumes that the prompt is longer than 7 but less than 15. ! The actual length is 12, but what the heck give DEC some leeway. ! Once we have a prompt it is save to do other operations. ! In particular data written to PTY before the prompt is "promptly" lost!!! !JC ----------------- Kludge ------------------------- IF (.TVT[TVT$RD_BCNT] GTR 7) AND ! JC Kludge (.TVT[TVT$RD_BCNT] LSS 15) ! JC Kludge THEN ! JC Kludge PTY_SET_OWNER_PID(.TVT); END; ! Print debug info IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL PTY_READ_DONE: #bytes=!SL,Data=[!AD]!/', 0, .TVT[TVT$TCB], .TVT[TVT$RD_BCNT], .TVT[TVT$RD_BCNT], TVT[TVT$RD_BUF]); END; ! Give this data to the network. ! WHILE (.TVT[TVT$RD_BCNT] GTR 0) DO ! BEGIN ! CHR = CH$RCHAR_A(TVT[TVT$RD_PTR]) ; ! PTY_TO_NET(.TVT, .CHR) ; ! TVT[TVT$RD_BCNT] = .TVT[TVT$RD_BCNT] - 1 ; ! END ; IF NOT .TVT[TVT$NWRITE] THEN BEGIN %IF USE_ASTS %THEN TCP_WRITE(.TVT); Byte_Count = .TCB[SND_Q_SIZE]-.TCB[SND_Q_COUNT]-.TCB[SRX_Q_COUNT]; IF ((.TVT[TVT$RD_BCNT] GTR 0) OR (.Byte_Count GTR 0)) THEN BEGIN $DCLAST(ASTADR = PTY_READ, ASTPRM = .TVT); END ; %ELSE $ACPWAKE; %FI END ; END; FORWARD ROUTINE PTY_WRITE_DONE : NOVALUE; ROUTINE PTY_WRITE(TVT) : NOVALUE = ! ! PTY_WRITE - Initiate a write to the PTY device, if there is data in the PTY ! write buffer. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND IO_Status = TVT[TVT$WR_IOSB] : PTY$IOSB; LOCAL Byte_Count, Bytes_Remaining, TT_WR_PTR, PTY_Char : BLOCK[8,BYTE], RC; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL PTY_WRITE: OCNT = !SL, OPTR = !SL!/', 0, .TVT[TVT$TCB], .TVT[TVT$WR_OCNT], .TVT[TVT$WR_OPTR]); END; ! If already doing a PTY write, then don't run here. IF .TVT[TVT$PWRITE] THEN RETURN; IF .TVT[TVT$DO_PID] THEN BEGIN !!! JC hold off till proc ready IF .TVT[TVT$HOLD] THEN RETURN; TVT[TVT$HOLD] = 1; END; ! Fill the TCP buffer TCP_READ(.TVT) ; ! If buffer empty, then don't run here. IF (.TVT[TVT$WR_BCNT] EQL 0) THEN RETURN; ! Indicate that there is now a write in progress TVT[TVT$PWRITE] = TRUE; ! Get size of typeahead buffer ! (This code doesn't really work - TYPEAHDCNT apparently doesn't work ! for PTY's...) ! (Have to put chan first? What a crock... -HWM) ! RC = $QIOW( ! CHAN = .TVT[TVT$PTY_CHN], ! FUNC = IO$_SENSEMODE+IO$M_TYPEAHDCNT, ! IOSB = TVT[TVT$WR_IOSB], ! P1 = PTY_Char, ! P2 = 8); ! IF NOT .RC THEN ! BEGIN ! XLOG$FAO(LOG$TCPERR, ! '!%T TVT PTY sensemode $QIO failure for TCB x!XL, RC=x!XL!/', ! 0, .TVT[TVT$TCB], .RC); ! END ; ! ! Bytes_Remaining = .PTY_Char[IO$V_TYPEAHDCNT] ; ! ! IF $$LOGF(LOG$TVT) THEN ! BEGIN ! LOG$FAO('!%T TCB x!XL PTY_WRITE: Bytes remaining = !SL, Status = !SL!/', ! 0, .TVT[TVT$TCB], .Bytes_Remaining, .IO_STATUS[PTSB$STATUS]) ; ! END; ! Compute realistic byte count IF (.TVT[TVT$WR_OPTR] LSS .TVT[TVT$WR_IPTR]) THEN BEGIN ! OPTR trailing IPTR, expected case, compute distance Byte_Count = (.TVT[TVT$WR_IPTR] - .TVT[TVT$WR_OPTR]) ; END ELSE BEGIN ! OPTR equals IPTR, nothing else to do here IF (.TVT[TVT$WR_OPTR] EQL .TVT[TVT$WR_IPTR]) THEN BEGIN TVT[TVT$PWRITE] = FALSE ; RETURN ; END ; ! IPTR trailing OPTR, IPTR wrapped, compute linear size remaining Byte_Count = TVT_TTY_BUFLEN - .TVT[TVT$WR_OPTR] ; END ; ! Byte_Count = MIN(.Byte_Count, PTY_BUFFER_SIZE) ; TT_WR_PTR = CH$PTR(TVT[TVT$WR_BUF], .TVT[TVT$WR_OPTR]) ; IF .TVT[TVT$DO_PID] THEN Byte_Count = 1; ! JC For hold off ! Do logging... IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL PTY_WRITE: #bytes=!SL, Byte Count = !SL,Data=[!AD]!/', 0,.TVT[TVT$TCB], .TVT[TVT$WR_BCNT], .Byte_Count, .Byte_Count, TVT[TVT$WR_BUF]) ; END; ! Initiate the write on the PTY ! opr$fao('pty_write !SL bytes (x!XL,x!XL)',.TVT[TVT$WR_BCNT],TVT[TVT$WR_BUF],.TVT[TVT$WR_PTR]); RC = $QIO( FUNC = IO$_WRITEVBLK, CHAN = .TVT[TVT$PTY_CHN], IOSB = TVT[TVT$WR_IOSB], ASTADR = PTY_WRITE_DONE, ASTPRM = .TVT, P1 = .TT_WR_PTR, P2 = .Byte_Count); IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR, '!%T TVT PTY write $QIO failure for TCB x!XL, RC=x!XL!/', 0,.TVT[TVT$TCB],.RC); ! IF .IO_Status[PTSB$EXTRA1] NEQ SS$_DATAOVERUN THEN TCB$DELETE(.TVT[TVT$TCB]); TVT[TVT$PWRITE] = FALSE; RETURN; END; END; ROUTINE PTY_WRITE_DONE(TVT) : NOVALUE = ! ! PTY_WRITE_DONE - AST routine when PTY write operation finishes. Try to get ! more data for the pty via TCP_READ. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND IOSB = TVT[TVT$WR_IOSB] : PTY$IOSB; LOCAL bytes_left, bytes_written, RC, TCB : REF TCB_STRUCTURE; ! Make sure the TVT is still valid IF .TVT[TVT$CANCEL] THEN BEGIN RETURN; END ; ! Check the status of the operation. RC = .IOSB[PTSB$STATUS]; IF .RC EQL SS$_CANCEL THEN BEGIN RETURN; END ; TCB = .TVT[TVT$TCB]; IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT write error for TCB x!XL, RC=x!XL!/', 0,.TCB,.RC); IF .RC NEQ SS$_DATAOVERUN THEN BEGIN TCB$DELETE(.TVT[TVT$TCB]); RETURN END; END; ! AST_IN_PROGRESS = TRUE; ! NOINT ; ! Update counters and pointers bytes_written = .IOSB[PTSB$NBYTES]; bytes_left = .TVT[TVT$WR_BCNT] - .Bytes_written ; TVT[TVT$WR_OPTR] = .TVT[TVT$WR_OPTR] + .bytes_Written ; TVT[TVT$WR_OCNT] = .TVT[TVT$WR_OCNT] + .Bytes_Written ; TVT[TVT$WR_BCNT] = .TVT[TVT$WR_BCNT] - .Bytes_Written ; IF (.TVT[TVT$WR_OPTR] GEQ TVT_TTY_BUFLEN) THEN BEGIN TVT[TVT$WR_OPTR] = 0 ; END ; ! IF (.bytes_left GTR 0) THEN ! BEGIN ! opr$fao('!!!pty_overun!!! !SL bytes',.bytes_left,TVT[TVT$WR_BUF],.TVT[TVT$WR_PTR]); ! CH$MOVE(.bytes_left, TVT[TVT$WR_BUF] + .bytes_left, TVT[TVT$WR_BUF]); ! TVT[TVT$WR_PTR] = .TVT[TVT$WR_BUF] + .bytes_left; ! END ; ! Indicate write no longer in progress and check for more data to send TVT[TVT$PWRITE] = FALSE; ! AST_IN_PROGRESS = FALSE; ! OKINT ; IF $$LOGF(LOG$TVT) THEN BEGIN LOG$FAO('!%T TCB x!XL PTY_WRITE_DONE: #bytes left=!SL, written = !SL!/', 0, .TVT[TVT$TCB], .bytes_left, .Bytes_written) ; END; ! Empty PTY buffers PTY_READ(.TVT) ; ! IF (NOT .TVT[TVT$NREAD]) AND (.TCB[RCV_Q_COUNT] GTR 0) THEN %IF USE_ASTS %THEN ! TCP_READ(.TVT); ! $DCLAST(ASTADR = PTY_WRITE, ! ASTPRM = .TVT); ! PTY_WRITE(.TVT) ; %ELSE $ACPWAKE; %FI END; %SBTTL 'Mailbox handling routines' ROUTINE MBX_READ(TVT) = ! ! MBX_READ - Initiate a read on the PTY's associated mailbox. ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL RC; ! Issue the read $QIO RC = $QIO(FUNC = IO$_READVBLK, CHAN = .TVT[TVT$MBX_CHN], IOSB = TVT[TVT$MBX_IOSB], ASTADR = MBX_READ_DONE, ASTPRM = .TVT, P1 = TVT[TVT$MBX_BUF], P2 = TVT_MBX_BUFLEN); IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT MBX Read failure for TCB x!XL, RC=x!XL!/', 0,.TVT[TVT$TCB],.RC); RETURN FALSE; END; RETURN TRUE; END; ROUTINE MBX_READ_DONE(TVT) : NOVALUE = ! ! Here when we receive a message on the mailbox associated with the PTY. If we ! receive the terminal hangup signal (i.e. PTY has gone away). ! BEGIN MAP TVT : REF TVT$BLOCK; BIND IOSB = TVT[TVT$MBX_IOSB] : $BBLOCK, MBLOCK = TVT[TVT$MBX_BUF] : $BBLOCK; LOCAL MTYPE, RC; ! Make sure the TVT is still valid IF .TVT[TVT$CANCEL] THEN RETURN; ! Check the status - ignore cancel/abort RC = .IOSB[0,0,16,0]; IF .RC EQLU SS$_ABORT THEN RETURN; IF .RC EQLU SS$_CANCEL THEN RETURN; ! Check for null status - just reqeueue the read ! AST_IN_PROGRESS = TRUE; ! NOINT ; IF .RC EQLU 0 THEN BEGIN MBX_READ(.TVT); ! AST_IN_PROGRESS = FALSE; ! OKINT ; RETURN; END; ! If we got an error, we have a problem. Abort. IF NOT .RC THEN BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT MBX read failure for TCB x!XL, RC=x!XL!/', 0,.TVT[TVT$TCB],.RC); TCB$DELETE(.TVT[TVT$TCB]); ! AST_IN_PROGRESS = FALSE; ! OKINT ; RETURN; END; ! Get the message type and dispatch it. MTYPE = .MBLOCK[0,0,16,0]; SELECTONE .MTYPE OF SET [MSG$_TRMHANGUP]: BEGIN XLOG$FAO(LOG$TCPERR,'!%T TVT hangup signal for TCB x!XL!/', 0,.TVT[TVT$TCB]); TCP$TCB_CLOSE(TVT[TVT$TCB]); ! AST_IN_PROGRESS = FALSE; ! OKINT ; RETURN; END; TES; ! If we didn't handle it, it was ignored. Requeue the read. ! AST_IN_PROGRESS = FALSE; ! OKINT ; MBX_READ(.TVT); END; %SBTTL 'Option negotiation routines' ROUTINE Set_State_ON (TVT, OPTBLK) : NOVALUE = BEGIN MAP TVT : REF TVT$BLOCK, OPTBLK : REF OPT$BLOCK; IF .OPTBLK[OPT$STATE] NEQ OPT$STATE_ON THEN BEGIN OPTBLK[OPT$STATE] = OPT$STATE_ON; IF (.OPTBLK[OPT$ON_RTN] NEQ 0) THEN (.OPTBLK[OPT$ON_RTN])(.TVT) END END; ROUTINE Set_State_OFF (TVT, OPTBLK) : NOVALUE = BEGIN MAP TVT : REF TVT$BLOCK, OPTBLK : REF OPT$BLOCK; IF .OPTBLK[OPT$STATE] NEQ OPT$STATE_OFF THEN BEGIN OPTBLK[OPT$STATE] = OPT$STATE_OFF; IF (.OPTBLK[OPT$OFF_RTN] NEQ 0) THEN (.OPTBLK[OPT$OFF_RTN])(.TVT) END END; FORWARD ROUTINE TVT_SEND : NOVALUE; ROUTINE TVT_READ_WILL(TVT,OPTION) : NOVALUE = ! ! Received a WILL for an option. Handle according to the option table. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND REMOPTS = TVT[TVT$REMOPTS] : OPT$LIST, OPTBLK = ( IF .OPTION LEQU TELNET$K_MAXOPT THEN REMOPTS[.OPTION,OPT$BASE] ELSE DEFAULT_OPTION_BLOCK) : OPT$BLOCK; ! Reset TVT read state XLOG$FAO(LOG$TELNEG,'!%T READ_Will !UB!/',0,.Option); TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; ! If currently doing the option, then turn it on IF .OPTBLK[OPT$CURRENT] THEN BEGIN OPTBLK[OPT$CURRENT] = FALSE; Set_State_ON(.TVT, OPTBLK) ; END ELSE ! Not currently doing negotiation. If we should turn it on, then do so. IF NOT .OPTBLK[OPT$STATE] THEN BEGIN IF (.OPTBLK[OPT$PREFER] EQL OPT$STATE_ON) OR (.OPTBLK[OPT$PREFER] EQL OPT$DONT_CARE) THEN BEGIN !!!JC OPTBLK [OPT$STATE] = OPT$STATE_ON; Set_State_ON(.TVT, OPTBLK); ! JC TVT_SEND(.TVT,TELNET$K_DO,.OPTION); END ELSE TVT_SEND(.TVT,TELNET$K_DONT,.OPTION); END END; ROUTINE TVT_READ_WONT(TVT,OPTION) : NOVALUE = ! ! Received a WONT for an option. Handle according to the option table. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND REMOPTS = TVT[TVT$REMOPTS] : OPT$LIST, OPTBLK = ( IF .OPTION LEQU TELNET$K_MAXOPT THEN REMOPTS[.OPTION,OPT$BASE] ELSE DEFAULT_OPTION_BLOCK) : OPT$BLOCK; ! Reset TVT read state XLOG$FAO(LOG$TELNEG,'!%T READ_Wont !UB!/',0,.Option); TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; ! If currently doing the option, then turn it off IF .OPTBLK[OPT$CURRENT] THEN BEGIN OPTBLK[OPT$CURRENT] = FALSE; Set_State_OFF(.TVT, OPTBLK); END ELSE ! Not currently doing negotiation. If we should turn it off, do so. ! We must not prevent the remote host from reverting back to NVT IF .OPTBLK[OPT$STATE] THEN BEGIN !!!JC OPTBLK[OPT$STATE] = OPT$STATE_OFF; Set_State_OFF(.TVT, OPTBLK); ! JC TVT_SEND(.TVT,TELNET$K_DONT,.OPTION); END END; ROUTINE TVT_READ_DO(TVT,OPTION) : NOVALUE = ! ! Received a DO for an option. Handle according to the option table. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND LCLOPTS = TVT[TVT$LCLOPTS] : OPT$LIST, OPTBLK = ( IF .OPTION LEQU TELNET$K_MAXOPT THEN LCLOPTS[.OPTION,OPT$BASE] ELSE DEFAULT_OPTION_BLOCK) : OPT$BLOCK; ! Reset TVT read state XLOG$FAO(LOG$TELNEG,'!%T READ_Do !UB!/',0,.Option); TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; ! If currently doing the option, then turn it on IF .OPTBLK[OPT$CURRENT] THEN BEGIN OPTBLK[OPT$CURRENT] = FALSE; !!!JC OPTBLK[OPT$STATE] = OPT$STATE_ON; ! Redundant Set_State_ON(.TVT, OPTBLK); ! JC Must set on END ELSE ! Not currently doing negotiation. If we should turn it on, then do so. IF NOT .OPTBLK[OPT$STATE] THEN BEGIN IF (.OPTBLK[OPT$PREFER] EQL OPT$STATE_ON) OR (.OPTBLK[OPT$PREFER] EQL OPT$DONT_CARE) THEN BEGIN !!!JC OPTBLK [OPT$STATE] = OPT$STATE_ON; Set_State_ON(.TVT, OPTBLK); ! JC TVT_SEND(.TVT,TELNET$K_WILL,.OPTION); END ELSE TVT_SEND(.TVT,TELNET$K_WONT,.OPTION); END; END; ROUTINE TVT_READ_DONT(TVT,OPTION) : NOVALUE = ! ! Received a DONT for an option. Handle according to the option table. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND LCLOPTS = TVT[TVT$LCLOPTS] : OPT$LIST, OPTBLK = ( IF .OPTION LEQU TELNET$K_MAXOPT THEN LCLOPTS[.OPTION,OPT$BASE] ELSE DEFAULT_OPTION_BLOCK) : OPT$BLOCK; ! Reset TVT read state XLOG$FAO(LOG$TELNEG,'!%T READ_Dont !UB!/',0,.Option); TVT[TVT$NRSTATE] = TVT$STATE_NORMAL; ! If currently doing the option, then turn it off IF .OPTBLK[OPT$CURRENT] THEN BEGIN OPTBLK[OPT$CURRENT] = FALSE; !!!JC OPTBLK[OPT$STATE] = OPT$STATE_OFF; Set_State_OFF(.TVT, OPTBLK); ! JC END ELSE ! Not currently doing negotiation. If we should turn it off, do so. ! We must not prevent the remote host from reverting back to NVT BEGIN IF .OPTBLK[OPT$STATE] THEN BEGIN !!!JC OPTBLK[OPT$STATE] = OPT$STATE_OFF; !!!JC OPTBLK[OPT$STATE] = OPT$STATE_OFF; Set_State_OFF(.TVT, OPTBLK); ! JC TVT_SEND(.TVT,TELNET$K_WONT,.OPTION); END ; END ; END; GLOBAL ROUTINE TVT_SEND(TVT,OPR,OPTION) : NOVALUE = ! ! Send a TVT option negotiation. We queue the bytes needed to implement the ! option negotiation in the option buffer, and attempt a network write if ! none is currently happening. ! BEGIN MAP TVT : REF TVT$BLOCK; LITERAL TVT_OPTION_LEN = 3; ! Make sure there is room for the bytes we need to send. XLOG$FAO(LOG$TELNEG,'!%T Send !UB!/',0,.Option); IF .TVT[TVT$NEG_CNT] GEQ (TVT_NEG_BUFLEN-TVT_OPTION_LEN) THEN RETURN; ! Insert the option negotiation bytes into the buffer IF .TVT[TVT$NEG_CNT] EQL 0 THEN TVT[TVT$NEG_EQP] = CH$PTR(TVT[TVT$NEG_BUF]); CH$WCHAR_A(TELNET$K_IAC,TVT[TVT$NEG_EQP]); CH$WCHAR_A(.OPR,TVT[TVT$NEG_EQP]); CH$WCHAR_A(.OPTION,TVT[TVT$NEG_EQP]); TVT[TVT$NEG_CNT] = .TVT[TVT$NEG_CNT] + TVT_OPTION_LEN; END; GLOBAL ROUTINE TVT_SEND_SUBOP(TVT,OPTION,DATA_A,SIZE) : NOVALUE = ! ! Send a TVT suboption negotiation. We queue the bytes needed to implement the ! option negotiation in the option buffer, and attempt a network write if ! none is currently happening. ! BEGIN BIND DATA = DATA_A; MAP TVT : REF TVT$BLOCK; LOCAL Char : UNSIGNED BYTE; ! Make sure there is room for the bytes we need to send. XLOG$FAO(LOG$TELNEG,'!%T Send_Subop !UB!/',0,.Option); IF .TVT[TVT$NEG_CNT] GEQ (TVT_NEG_BUFLEN-(.Size+5)) THEN RETURN; ! Insert the option negotiation bytes into the buffer IF .TVT[TVT$NEG_CNT] EQL 0 THEN TVT[TVT$NEG_EQP] = CH$PTR(TVT[TVT$NEG_BUF]); ! Write the suboption header. CH$WCHAR_A(TELNET$K_IAC,TVT[TVT$NEG_EQP]); CH$WCHAR_A(TELNET$K_SB,TVT[TVT$NEG_EQP]); CH$WCHAR_A(.OPTION,TVT[TVT$NEG_EQP]); ! Write the suboption data ! CH$WCHAR_A(Option$K_Tog_Flow_Cntl_OFF,TVT[TVT$NEG_EQP]); INCR i FROM 0 TO .Size-1 DO BEGIN Char = CH$RCHAR_A(Data); CH$WCHAR_A(.Char,TVT[TVT$NEG_EQP]) END; ! Write the suboption trailer CH$WCHAR_A(TELNET$K_IAC,TVT[TVT$NEG_EQP]); CH$WCHAR_A(TELNET$K_SE,TVT[TVT$NEG_EQP]); TVT[TVT$NEG_CNT] = .TVT[TVT$NEG_CNT] + (.Size+5); END; ROUTINE TVT_READ_SUB(TVT) : NOVALUE = ! ! Received a Suboption for an option. Handle according to the option table. ! BEGIN MAP TVT : REF TVT$BLOCK; BIND OPTS = TVT[TVT$REMOPTS] : OPT$LIST; LOCAL sub_func, opt : UNSIGNED BYTE; opt = CH$RCHAR_A(TVT[TVT$SUB_PTR]); XLOG$FAO(LOG$TELNEG,'!%T READ_Sub !UB!/',0,.Opt); TVT[TVT$SUB_CNT] = .TVT[TVT$SUB_CNT] -1 ; ! If everything is kosher, execute the suboption handler. IF .opt LEQU TELNET$K_MAXOPT THEN IF (.OPTS[.opt,OPT$SUB_RTN] NEQ 0) AND (.OPTS[.opt,OPT$STATE] EQL OPT$STATE_ON) THEN (.OPTS[.opt,OPT$SUB_RTN])(.TVT) END; ROUTINE TVT_NEGOTIATE(TVT) : NOVALUE = ! ! Initiate option negotiation for all of the negotiations that we prefer to be ! in the ON state. Loops through LCLOPTS, sending WILLs and REMOPTS sending ! DOs for them. ! BEGIN MAP TVT : REF TVT$BLOCK; LOCAL OPTION; BIND LCLOPTS = TVT[TVT$LCLOPTS] : OPT$LIST, REMOPTS = TVT[TVT$REMOPTS] : OPT$LIST; ! First, do local options (offer to WILL them) INCR OPTION FROM TELNET$K_MINOPT TO TELNET$K_MAXOPT DO BEGIN BIND OPTBLK = LCLOPTS[.OPTION,OPT$BASE] : OPT$BLOCK; ! If off and we prefer on, send a WILL IF (NOT .OPTBLK[OPT$STATE]) AND (.OPTBLK[OPT$PREFER] EQL OPT$STATE_ON) THEN BEGIN OPTBLK[OPT$CURRENT] = TRUE; TVT_SEND(.TVT,TELNET$K_WILL,.OPTION); END; ! If on and we prefer it off, send a WONT IF .OPTBLK[OPT$STATE] AND (.OPTBLK[OPT$PREFER] EQL OPT$STATE_OFF) THEN BEGIN OPTBLK[OPT$CURRENT] = TRUE; TVT_SEND(.TVT,TELNET$K_WONT,.OPTION); END; END; ! Then, do remote options (ask remote to DO them) INCR OPTION FROM TELNET$K_MINOPT TO TELNET$K_MAXOPT DO BEGIN BIND OPTBLK = REMOPTS[.OPTION,OPT$BASE] : OPT$BLOCK; ! If off and we prefer on, send a DO IF (NOT .OPTBLK[OPT$STATE]) AND (.OPTBLK[OPT$PREFER] EQL OPT$STATE_ON) THEN BEGIN OPTBLK[OPT$CURRENT] = TRUE; TVT_SEND(.TVT,TELNET$K_DO,.OPTION); END; ! If on and we prefer it off, send a DONT IF .OPTBLK[OPT$STATE] AND (.OPTBLK[OPT$PREFER] EQL OPT$STATE_OFF) THEN BEGIN OPTBLK[OPT$CURRENT] = TRUE; TVT_SEND(.TVT,TELNET$K_DONT,.OPTION); END; END; END; END ELUDOM