restemplate/indy/Protocols/IdTelnet.pas

742 lines
23 KiB
Plaintext

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.15 2/13/05 7:21:30 PM RLebeau
Updated TIdTelnetReadThread.Run() to use a timeout when calling the
IOHandler's CheckForDataOnSource() method.
Rev 1.14 10/07/2004 10:00:28 ANeillans
Fixed compile bug
Rev 1.13 7/8/04 4:12:06 PM RLebeau
Updated calls to Write() to use the IOHandler
Rev 1.12 7/4/04 1:38:36 PM RLebeau
Updated Negotiate() to trigger the OnDataAvailable event only when data is
actually available.
Rev 1.11 5/16/04 3:14:06 PM RLebeau
Added destructor to terminate the reading thread
Rev 1.10 3/29/04 11:47:00 AM RLebeau
Updated to support new ThreadedEvent property
Rev 1.9 2004.03.06 1:31:56 PM czhower
To match Disconnect changes to core.
Rev 1.8 2004.02.03 5:44:32 PM czhower
Name changes
Rev 1.7 1/21/2004 4:20:48 PM JPMugaas
InitComponent
Rev 1.6 2003.11.29 10:20:16 AM czhower
Updated for core change to InputBuffer.
Rev 1.5 3/6/2003 5:08:50 PM SGrobety
Updated the read buffer methodes to fit the new core (InputBuffer ->
InputBufferAsString + call to CheckForDataOnSource)
Rev 1.4 2/24/2003 10:32:46 PM JPMugaas
Rev 1.3 12/8/2002 07:26:10 PM JPMugaas
Added published host and port properties.
Rev 1.2 12/7/2002 06:43:30 PM JPMugaas
These should now compile except for Socks server. IPVersion has to be a
property someplace for that.
Rev 1.1 12/6/2002 05:30:40 PM JPMugaas
Now decend from TIdTCPClientCustom instead of TIdTCPClient.
Rev 1.0 11/13/2002 08:02:50 AM JPMugaas
03-01-2002 Andrew P.Rybin Renamings and standardization
26-05-2000 SG: Converted to Indy, no other change
07-Mar-2000 Mark Added a bunch of stuff... it's very much a work in progress
05-Mar-2000 Mark Added constants for telnet implememtation.
13-JAN-2000 MTL: Moved to new Palette Scheme (Winshoes Servers)
}
unit IdTelnet;
{
Author: Mark Holmes
This is the telnet client component. I'm still testing
There is no real terminal emulation other than dumb terminal
}
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdAssignedNumbers,
IdGlobal,
IdException,
IdStack,
IdTCPClient, IdThread;
const
{ These are the telnet command constansts from RFC 854 }
TNC_EOR = $EF; // End of Record RFC 885
TNC_SE = $F0; // End of subnegotiation parameters.
TNC_NOP = $F1; // No operation.
TNC_DATA_MARK = $F2; // The data stream portion of a Synch.
// This should always be accompanied
// by a TCP Urgent notification.
TNC_BREAK = $F3; // NVT character BRK.
TNC_IP = $F4; // The function IP.
TNC_AO = $F5; // The function ABORT OUTPUT.
TNC_AYT = $F6; // The function ARE YOU THERE.
TNC_EC = $F7; // The function ERASE CHARACTER.
TNC_EL = $F8; // The function ERASE LINE.
TNC_GA = $F9; // The GO AHEAD signal.
TNC_SB = $FA; // Indicates that what follows is
// subnegotiation of the indicated
// option.
TNC_WILL = $FB; // Indicates the desire to begin
// performing, or confirmation that
// you are now performing, the
// indicated option.
TNC_WONT = $FC; // Indicates the refusal to perform,
// or continue performing, the
// indicated option.
TNC_DO = $FD; // Indicates the request that the
// other party perform, or
// confirmation that you are expecting
// the other party to perform, the
// indicated option.
TNC_DONT = $FE; // Indicates the demand that the
// other party stop performing,
// or confirmation that you are no
// longer expecting the other party
// to perform, the indicated option.
TNC_IAC = $FF; // Data Byte 255.
{ Telnet options registered with IANA }
TNO_BINARY = $00; // Binary Transmission
TNO_ECHO = $01; // Echo
TNO_RECONNECT = $02; // Reconnection
TNO_SGA = $03; // Suppress Go Ahead
TNO_AMSN = $04; // Approx Message Size Negotiation
TNO_STATUS = $05; // Status
TNO_TIMING_MARK = $06; // Timing Mark
TNO_RCTE = $07; // Remote Controlled Trans and Echo -BELL
TNO_OLW = $08; // Output Line Width
TNO_OPS = $09; // Output Page Size
TNO_OCRD = $0A; // Output Carriage-Return Disposition
TNO_OHTS = $0B; // Output Horizontal Tab Stops
TNO_OHTD = $0C; // Output Horizontal Tab Disposition
TNO_OFD = $0D; // Output Formfeed Disposition
TNO_OVT = $0E; // Output Vertical Tabstops
TNO_OVTD = $0F; // Output Vertical Tab Disposition
TNO_OLD = $10; // Output Linefeed Disposition
TNO_EA = $11; // Extended ASCII
TNO_LOGOUT = $12; // Logout
TNO_BYTE_MACRO = $13; // Byte Macro
TNO_DET = $14; // Data Entry Terminal
TNO_SUPDUP = $15; // SUPDUP
TNO_SUPDUP_OUTPUT = $16; // SUPDUP Output
TNO_SL = $17; // Send Location
TNO_TERMTYPE = $18; // Terminal Type
TNO_EOR = $19; // End of Record
TNO_TACACS_ID = $1A; // TACACS User Identification
TNO_OM = $1B; // Output Marking
TNO_TLN = $1C; // Terminal Location Number
TNO_3270REGIME = $1D; // 3270 regime
TNO_X3PAD = $1E; // X.3 PAD
TNO_NAWS = $1F; // Window size
TNO_TERM_SPEED = $20; // Terminal speed
TNO_RFLOW = $21; // Remote flow control
TNO_LINEMODE = $22; // Linemode option
TNO_XDISPLOC = $23; // X Display Location
TNO_ENV = $24; // Environment
TNO_AUTH = $25; // Authenticate
TNO_ENCRYPT = $26; // Encryption option
TNO_NEWENV = $27;
TNO_TN3270E = $28;
TNO_XAUTH = $29;
TNO_CHARSET = $2A;
TNO_RSP = $2B;
TNO_COMPORT = $2C;
TNO_SUPLOCALECHO = $2D;
TNO_STARTTLS = $2E;
TNO_KERMIT = $2F;
TNO_SEND_URL = $30;
TNO_FORWARD_X = $31;
// 50-137 = Unassigned
TNO_PRAGMA_LOGON = $8A;
TNO_SSPI_LOGON = $8B;
TNO_PRAGMA_HEARTBEAT = $8C;
TNO_EOL = $FF; // Extended-Options-List
// Sub options
TNOS_TERM_IS = $00;
TNOS_TERMTYPE_SEND = $01; // Sub option
TNOS_REPLY = $02;
TNOS_NAME = $03;
//Auth commands
TNOAUTH_IS = $00;
TNOAUTH_SEND = $01;
TNOAUTH_REPLY = $02;
TNOAUTH_NAME = $03;
// Auth options $25
TNOAUTH_NULL = $00;
TNOAUTH_KERBEROS_V4 = $01;
TNOAUTH_KERBEROS_V5 = $02;
TNOAUTH_SPX = $03;
TNOAUTH_MINK = $04;
TNOAUTH_SRP = $05;
TNOAUTH_RSA = $06;
TNOAUTH_SSL = $07;
TNOAUTH_LOKI = $0A;
TNOAUTH_SSA = $0B;
TNOAUTH_KEA_SJ = $0C;
TNOAUTH_KEA_SJ_INTEG = $0D;
TNOAUTH_DSS = $0E;
TNOAUTH_NTLM = $0F;
//Kerberos4 Telnet Authentication suboption commands
TNOAUTH_KRB4_AUTH = $00;
TNOAUTH_KRB4_REJECT = $01;
TNOAUTH_KRB4_ACCEPT = $02;
TNOAUTH_KRB4_CHALLENGE = $03;
TNOAUTH_KRB4_RESPONSE = $04;
TNOAUTH_KRB4_FORWARD = $05;
TNOAUTH_KRB4_FORWARD_ACCEPT = $06;
TNOAUTH_KRB4_FORWARD_REJECT = $07;
TNOAUTH_KRB4_EXP = $08;
TNOAUTH_KRB4_PARAMS = $09;
//Kerberos5 Telnet Authentication suboption commands
TNOAUTH_KRB5_AUTH = $00;
TNOAUTH_KRB5_REJECT = $01;
TNOAUTH_KRB5_ACCEPT = $02;
TNOAUTH_KRB5_RESPONSE = $03;
TNOAUTH_KRB5_FORWARD = $04;
TNOAUTH_KRB5_FORWARD_ACCEPT = $05;
TNOAUTH_KRB5_FORWARD_REJECT = $06;
//DSS Telnet Authentication suboption commands
TNOAUTH_DSS_INITIALIZE = $01;
TNOAUTH_DSS_TOKENBA = $02;
TNOAUTH_DSS_CERTA_TOKENAB = $03;
TNOAUTH_DSS_CERTB_TOKENBA2 = $04;
//SRP Telnet Authentication suboption commands
TNOAUTH_SRP_AUTH = $00;
TNOAUTH_SRP_REJECT = $01;
TNOAUTH_SRP_ACCEPT = $02;
TNOAUTH_SRP_CHALLENGE = $03;
TNOAUTH_SRP_RESPONSE = $04;
TNOAUTH_SRP_EXP = $08;
TNOAUTH_SRP_PARAMS = $09;
// KEA_SJ and KEA_SJ_INTEG Telnet Authenticatio suboption commands
TNOAUTH_KEA_CERTA_RA = $01;
TNOAUTH_KEA_CERTB_RB_IVB_NONCEB = $02;
TNOAUTH_KEA_IVA_RESPONSEB_NONCEA = $03;
TNOAUTH_KEA_RESPONSEA = $04;
//Telnet Encryption Types (Option 38)
// commands
TNOENC_IS = $00;
TNOENC_SUPPORT = $01;
TNOENC_REPLY = $02;
TNOENC_START = $03;
TNOENC_END = $04;
TNOENC_REQUEST_START = $05;
TNOENC_REQUEST_END = $06;
TNOENC_ENC_KEYID = $07;
TNOENC_DEC_KEYID = $08;
// types
TNOENC_NULL = $00;
TNOENC_DES_CFB64 = $01;
TNOENC_DES_OFB64 = $02;
TNOENC_DES3_CFB64 = $03;
TNOENC_DES3_OFB64 = $04;
TNOENC_CAST5_40_CFB64 = $08;
TNOENC_CAST5_40_OFB64 = $09;
TNOENC_CAST128_CFB64 = $0A;
TNOENC_CAST128_OFB64 = $0B;
TNOENC_AES_CCM = $0C;
//DES3_CFB64 Telnet Encryption type suboption commands
TNOENC_CFB64_IV = $01;
TNOENC_CFB64_IV_OK = $02;
TNOENC_CFB64_IV_BAD = $03;
//CAST5_40_OFB64 and CAST128_OFB64 Telnet Encryption types suboption commands
TNOENC_OFB64_IV = $01;
TNOENC_OFB64_IV_OK = $02;
TNOENC_OFB64_IV_BAD = $03;
//CAST5_40_CFB64 and CAST128_CFB64 Telnet Encryption types suboption commands
//same as DES3_CFB64 Telnet Encryption type suboption commands
//DES_CFB64 Telnet Encryption type
//same as DES3_CFB64 Telnet Encryption type suboption commands
//DES_OFB64 Telnet Encryption type
//same as CAST5_40_OFB64 and CAST128_OFB64 Telnet Encryption types suboption commands
type
TIdTelnet = class;
{Commands to telnet client from server}
TIdTelnetCommand = (tncNoLocalEcho, tncLocalEcho, tncEcho);
TIdTelnetDataAvailEvent = procedure (Sender: TIdTelnet; const Buffer: TIdBytes) of object;
TIdTelnetCommandEvent = procedure(Sender: TIdTelnet; Status: TIdTelnetCommand) of object;
{This object is for the thread that listens for the telnet server responses
to key input and initial protocol negotiations }
TIdTelnetReadThread = class(TIdThread)
protected
FClient: TIdTelnet;
//
procedure Run; override;
public
constructor Create(AClient: TIdTelnet); reintroduce;
property Client: TIdTelnet read FClient;
end; //TIdTelnetReadThread
TIdTelnet = class(TIdTCPClientCustom)
protected
fTerminal : String;
fThreadedEvent: Boolean;
FOnDataAvailable: TIdTelnetDataAvailEvent;
fIamTelnet: Boolean;
FOnTelnetCommand: TIdTelnetCommandEvent;
FTelnetThread: TIdTelnetReadThread;
//
procedure DoOnDataAvailable(const Buf: TIdBytes);
// Are we connected to a telnet server or some other server?
property IamTelnet: Boolean read fIamTelnet write fIamTelnet;
// Protocol negotiation begins here
procedure Negotiate;
// Handle the termtype request
procedure Handle_SB(const SbType: Byte; const SbData: TIdBytes);
// Send the protocol resp to the server based on what's in Reply {Do not Localize}
procedure SendNegotiationResp(const Response: Byte; const ResponseData: Byte);
procedure SendSubNegotiationResp(const SbType: Byte; const ResponseData: TIdBytes);
// Update the telnet status
procedure DoTelnetCommand(Status: TIdTelnetCommand);
procedure InitComponent; override;
public
//
{$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
constructor Create(AOwner: TComponent); reintroduce; overload;
{$ENDIF}
destructor Destroy; override;
procedure Connect; override;
procedure Disconnect(ANotifyPeer: Boolean); override;
procedure SendCh(Ch: Char);
procedure SendString(const S: String);
property TelnetThread: TIdTelnetReadThread read FTelnetThread;
published
property Host;
property Port default IdPORT_TELNET;
property OnTelnetCommand: TIdTelnetCommandEvent read FOnTelnetCommand write FOnTelnetCommand;
property OnDataAvailable: TIdTelnetDataAvailEvent read FOnDataAvailable write FOnDataAvailable;
property Terminal: string read fTerminal write fTerminal;
property ThreadedEvent: Boolean read fThreadedEvent write fThreadedEvent default False;
end;
EIdTelnetError = class(EIdException);
EIdTelnetClientConnectError = class(EIdTelnetError);
EIdTelnetServerOnDataAvailableIsNil = class(EIdTelnetError);
implementation
uses
IdResourceStringsCore,
IdResourceStringsProtocols,
SysUtils;
constructor TIdTelnetReadThread.Create(AClient: TIdTelnet);
begin
FClient := AClient;
inherited Create(False);
end;
procedure TIdTelnetReadThread.Run;
begin
// if we have data run it through the negotiation routine. If we aren't
// connected to a telnet server then the data just passes through the
// negotiate routine unchanged.
// RLebeau 3/29/04 - made Negotiate() get called by Synchronize() to
// ensure that the OnTelnetCommand event handler is synchronized when
// ThreadedEvent is false
if FClient.IOHandler.InputBufferIsEmpty then begin
FClient.IOHandler.CheckForDataOnSource(IdTimeoutInfinite);
end;
if not FClient.IOHandler.InputBufferIsEmpty then begin
if FClient.ThreadedEvent then begin
FClient.Negotiate;
end else begin
Synchronize(FClient.Negotiate);
end;
end;
FClient.IOHandler.CheckForDisconnect;
end;
{ TIdTelnet }
procedure TIdTelnet.SendCh(Ch : Char);
begin
// this code is necessary to allow the client to receive data properly
// from a non-telnet server
if Connected then begin
if (Ch <> CR) or IamTelnet then begin
IOHandler.Write(Ch);
end else begin
IOHandler.Write(EOL);
end;
end;
end;
procedure TIdTelnet.SendString(const S : String);
var
I: Integer;
Ch: Char;
begin
// this code is necessary to allow the client to receive data properly
// from a non-telnet server
for I := 1 to Length(S) do begin
try
Ch := S[I];
if (Ch <> CR) or IamTelnet then begin
IOHandler.Write(Ch);
end else begin
IOHandler.Write(EOL);
end;
except
end;
end;
end;
{$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
constructor TIdTelnet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
{$ENDIF}
procedure TIdTelnet.InitComponent;
begin
inherited InitComponent;
Terminal := 'dumb'; {Do not Localize}
ThreadedEvent := False;
IamTelnet := False;
Port := IdPORT_TELNET;
end;
destructor TIdTelnet.Destroy;
begin
Disconnect;
inherited Destroy;
end;
procedure TIdTelnet.Disconnect(ANotifyPeer: Boolean);
begin
if Assigned(FTelnetThread) then begin
FTelnetThread.Terminate;
end;
try
inherited Disconnect(ANotifyPeer);
finally
if Assigned(FTelnetThread) and (not IsCurrentThread(FTelnetThread)) then begin
FTelnetThread.WaitFor;
FreeAndNil(FTelnetThread);
end;
end;
end;
procedure TIdTelnet.DoOnDataAvailable(const Buf: TIdBytes);
begin
if Assigned(FOnDataAvailable) then begin
OnDataAvailable(Self, Buf);
end else begin
raise EIdTelnetServerOnDataAvailableIsNil.Create(RSTELNETSRVOnDataAvailableIsNil);
end;
end;
procedure TIdTelnet.Connect;
begin
inherited Connect;
try
// create the reading thread and assign the current Telnet object to it
IAmTelnet := False;
FTelnetThread := TIdTelnetReadThread.Create(Self);
except
Disconnect(True);
IndyRaiseOuterException(EIdTelnetClientConnectError.Create(RSNoCreateListeningThread)); // translate
end;
end;
procedure TIdTelnet.SendNegotiationResp(const Response: Byte; const ResponseData: Byte);
var
Resp: TIdBytes;
begin
SetLength(Resp, 3);
Resp[0] := TNC_IAC;
Resp[1] := Response;
Resp[2] := ResponseData;
IOHandler.Write(Resp);
end;
procedure TIdTelnet.SendSubNegotiationResp(const SbType: Byte; const ResponseData: TIdBytes);
var
Resp: TIdBytes;
begin
SetLength(Resp, 3 + Length(ResponseData) + 2);
Resp[0] := TNC_IAC;
Resp[1] := TNC_SB;
Resp[2] := SbType;
CopyTIdBytes(ResponseData, 0, Resp, 3, Length(ResponseData));
Resp[Length(Resp)-2] := TNC_IAC;
Resp[Length(Resp)-1] := TNC_SE;
IOHandler.Write(Resp);
end;
procedure TIdTelnet.Handle_SB(const SbType: Byte; const SbData: TIdBytes);
var
Resp: TIdBytes;
LTerminal: String;
begin
Resp := nil;
case SbType of
TNO_TERMTYPE:
if (Length(SbData) > 0) and (SbData[0] = TNOS_TERMTYPE_SEND) then
begin
// if someone inadvertantly sets Terminal to null
// You can set terminal to anything you want I suppose but be
// prepared to handle the data emulation yourself
LTerminal := Terminal;
if LTerminal = '' then begin
Terminal := 'UNKNOWN'; {Do not Localize}
end;
SetLength(Resp, 1);
Resp[0] := TNOS_TERM_IS;
AppendString(Resp, LTerminal);
SendSubNegotiationResp(TNO_TERMTYPE, Resp);
end;
end;
// add authentication code here
end;
procedure TIdTelnet.Negotiate;
var
b : Byte;
nBuf : TIdBytes;
sbBuf : TIdBytes;
CurrentSb : Byte;
Reply : Byte;
begin
nBuf := nil;
sbBuf := nil;
repeat
b := IOHandler.ReadByte;
if b <> TNC_IAC then
begin
AppendByte(nBuf, b);
Continue;
end;
{ start of command sequence }
IamTelnet := True;
b := IOHandler.ReadByte;
if b = TNC_IAC then
begin
AppendByte(nBuf, TNC_IAC);
Continue;
end;
case b of
TNC_WILL:
begin
b := IOHandler.ReadByte;
case b of
TNO_ECHO:
begin
Reply := TNC_DO;
DoTelnetCommand(tncNoLocalEcho);
//doStatus('NOLOCALECHO'); {Do not Localize}
end;
TNO_EOR:
Reply := TNC_DO;
else
Reply := TNC_DONT;
end;
SendNegotiationResp(Reply, b);
end;
TNC_WONT:
begin
b := IOHandler.ReadByte;
case b of
TNO_ECHO:
begin
Reply := TNC_DONT;
DoTelnetCommand(tncLocalEcho);
//Dostatus('LOCALECHO'); {Do not Localize}
end;
else
Reply := TNC_DONT;
end;
SendNegotiationResp(Reply, b);
end;
TNC_DONT:
begin
b := IOHandler.ReadByte;
case b of
TNO_ECHO:
begin
DoTelnetCommand(tncEcho);
//DoStatus('ECHO'); {Do not Localize}
Reply := TNC_WONT;
end;
else
Reply := TNC_WONT;
end;
SendNegotiationResp(Reply, b);
end;
TNC_DO:
begin
b := IOHandler.ReadByte;
case b of
TNO_ECHO:
begin
Reply := TNC_WILL;
DoTelnetCommand(tncLocalEcho);
end;
TNO_TERMTYPE:
Reply := TNC_WILL;
//TNO_NAWS:
TNO_AUTH:
begin
{
if (Authentication) then begin
Reply := TNC_WILL;
end else
}
begin
Reply := TNC_WONT;
end;
end;
else
Reply := TNC_WONT;
end;
SendNegotiationResp(Reply, b);
end;
TNC_EOR:
begin
// send any current data to the app
if Length(nBuf) > 0 then
begin
DoOnDataAvailable(nBuf);
SetLength(nBuf, 0);
end;
end;
TNC_SB:
begin
SetLength(sbBuf, 0);
// send any current data to the app, as the sub-negotiation
// may affect how subsequent data needs to be processed...
if Length(nBuf) > 0 then
begin
DoOnDataAvailable(nBuf);
SetLength(nBuf, 0);
end;
CurrentSB := IOHandler.ReadByte;
repeat
b := IOHandler.ReadByte;
if b = TNC_IAC then
begin
b := IOHandler.ReadByte;
case b of
TNC_IAC:
begin
AppendByte(sbBuf, TNC_IAC);
end;
TNC_SE:
begin
Handle_Sb(CurrentSB, sbBuf);
SetLength(sbBuf, 0);
Break;
end;
TNC_SB:
begin
Handle_Sb(CurrentSB, sbBuf);
SetLength(sbBuf, 0);
CurrentSB := IOHandler.ReadByte;
end;
end;
end else begin
AppendByte(sbBuf, b);
end;
until False;
end;
end;
until IOHandler.InputBufferIsEmpty;
// if any data remains then send this data to the app
if Length(nBuf) > 0 then begin
DoOnDataAvailable(nBuf);
end;
end;
procedure TIdTelnet.DoTelnetCommand(Status: TIdTelnetCommand);
begin
if Assigned(FOnTelnetCommand) then
FOnTelnetCommand(Self, Status);
end;
END.