source: trunk/Packages/synapse/tlntsend.pas

Last change on this file was 5, checked in by chronos, 13 years ago
  • Added: Required packages.
File size: 11.0 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.003.000 |
3|==============================================================================|
4| Content: TELNET and SSH2 client |
5|==============================================================================|
6| Copyright (c)1999-2008, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c)2002-2008. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{:@abstract(Telnet script client)
46
47Used RFC: RFC-854
48}
49
50{$IFDEF FPC}
51 {$MODE DELPHI}
52{$ENDIF}
53{$H+}
54
55unit tlntsend;
56
57interface
58
59uses
60 SysUtils, Classes,
61 blcksock, synautil;
62
63const
64 cTelnetProtocol = '23';
65 cSSHProtocol = '22';
66
67 TLNT_EOR = #239;
68 TLNT_SE = #240;
69 TLNT_NOP = #241;
70 TLNT_DATA_MARK = #242;
71 TLNT_BREAK = #243;
72 TLNT_IP = #244;
73 TLNT_AO = #245;
74 TLNT_AYT = #246;
75 TLNT_EC = #247;
76 TLNT_EL = #248;
77 TLNT_GA = #249;
78 TLNT_SB = #250;
79 TLNT_WILL = #251;
80 TLNT_WONT = #252;
81 TLNT_DO = #253;
82 TLNT_DONT = #254;
83 TLNT_IAC = #255;
84
85type
86 {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.}
87 TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT,
88 tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC);
89
90 {:@abstract(Class with implementation of Telnet/SSH script client.)
91
92 Note: Are you missing properties for specify server address and port? Look to
93 parent @link(TSynaClient) too!}
94 TTelnetSend = class(TSynaClient)
95 private
96 FSock: TTCPBlockSocket;
97 FBuffer: Ansistring;
98 FState: TTelnetState;
99 FSessionLog: Ansistring;
100 FSubNeg: Ansistring;
101 FSubType: Ansichar;
102 FTermType: Ansistring;
103 function Connect: Boolean;
104 function Negotiate(const Buf: Ansistring): Ansistring;
105 procedure FilterHook(Sender: TObject; var Value: AnsiString);
106 public
107 constructor Create;
108 destructor Destroy; override;
109
110 {:Connects to Telnet server.}
111 function Login: Boolean;
112
113 {:Connects to SSH2 server and login by Username and Password properties.
114
115 You must use some of SSL plugins with SSH support. For exammple CryptLib.}
116 function SSHLogin: Boolean;
117
118 {:Logout from telnet server.}
119 procedure Logout;
120
121 {:Send this data to telnet server.}
122 procedure Send(const Value: string);
123
124 {:Reading data from telnet server until Value is readed. If it is not readed
125 until timeout, result is @false. Otherwise result is @true.}
126 function WaitFor(const Value: string): Boolean;
127
128 {:Read data terminated by terminator from telnet server.}
129 function RecvTerminated(const Terminator: string): string;
130
131 {:Read string from telnet server.}
132 function RecvString: string;
133 published
134 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
135 property Sock: TTCPBlockSocket read FSock;
136
137 {:all readed datas in this session (from connect) is stored in this large
138 string.}
139 property SessionLog: Ansistring read FSessionLog write FSessionLog;
140
141 {:Terminal type indentification. By default is 'SYNAPSE'.}
142 property TermType: Ansistring read FTermType write FTermType;
143 end;
144
145implementation
146
147constructor TTelnetSend.Create;
148begin
149 inherited Create;
150 FSock := TTCPBlockSocket.Create;
151 FSock.OnReadFilter := FilterHook;
152 FTimeout := 60000;
153 FTargetPort := cTelnetProtocol;
154 FSubNeg := '';
155 FSubType := #0;
156 FTermType := 'SYNAPSE';
157end;
158
159destructor TTelnetSend.Destroy;
160begin
161 FSock.Free;
162 inherited Destroy;
163end;
164
165function TTelnetSend.Connect: Boolean;
166begin
167 // Do not call this function! It is calling by LOGIN method!
168 FBuffer := '';
169 FSessionLog := '';
170 FState := tsDATA;
171 FSock.CloseSocket;
172 FSock.LineBuffer := '';
173 FSock.Bind(FIPInterface, cAnyPort);
174 FSock.Connect(FTargetHost, FTargetPort);
175 Result := FSock.LastError = 0;
176end;
177
178function TTelnetSend.RecvTerminated(const Terminator: string): string;
179begin
180 Result := FSock.RecvTerminated(FTimeout, Terminator);
181end;
182
183function TTelnetSend.RecvString: string;
184begin
185 Result := FSock.RecvTerminated(FTimeout, CRLF);
186end;
187
188function TTelnetSend.WaitFor(const Value: string): Boolean;
189begin
190 Result := FSock.RecvTerminated(FTimeout, Value) <> '';
191end;
192
193procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString);
194begin
195 Value := Negotiate(Value);
196 FSessionLog := FSessionLog + Value;
197end;
198
199function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring;
200var
201 n: integer;
202 c: Ansichar;
203 Reply: Ansistring;
204 SubReply: Ansistring;
205begin
206 Result := '';
207 for n := 1 to Length(Buf) do
208 begin
209 c := Buf[n];
210 Reply := '';
211 case FState of
212 tsData:
213 if c = TLNT_IAC then
214 FState := tsIAC
215 else
216 Result := Result + c;
217
218 tsIAC:
219 case c of
220 TLNT_IAC:
221 begin
222 FState := tsData;
223 Result := Result + TLNT_IAC;
224 end;
225 TLNT_WILL:
226 FState := tsIAC_WILL;
227 TLNT_WONT:
228 FState := tsIAC_WONT;
229 TLNT_DONT:
230 FState := tsIAC_DONT;
231 TLNT_DO:
232 FState := tsIAC_DO;
233 TLNT_EOR:
234 FState := tsDATA;
235 TLNT_SB:
236 begin
237 FState := tsIAC_SB;
238 FSubType := #0;
239 FSubNeg := '';
240 end;
241 else
242 FState := tsData;
243 end;
244
245 tsIAC_WILL:
246 begin
247 case c of
248 #3: //suppress GA
249 Reply := TLNT_DO;
250 else
251 Reply := TLNT_DONT;
252 end;
253 FState := tsData;
254 end;
255
256 tsIAC_WONT:
257 begin
258 Reply := TLNT_DONT;
259 FState := tsData;
260 end;
261
262 tsIAC_DO:
263 begin
264 case c of
265 #24: //termtype
266 Reply := TLNT_WILL;
267 else
268 Reply := TLNT_WONT;
269 end;
270 FState := tsData;
271 end;
272
273 tsIAC_DONT:
274 begin
275 Reply := TLNT_WONT;
276 FState := tsData;
277 end;
278
279 tsIAC_SB:
280 begin
281 FSubType := c;
282 FState := tsIAC_SBDATA;
283 end;
284
285 tsIAC_SBDATA:
286 begin
287 if c = TLNT_IAC then
288 FState := tsSBDATA_IAC
289 else
290 FSubNeg := FSubNeg + c;
291 end;
292
293 tsSBDATA_IAC:
294 case c of
295 TLNT_IAC:
296 begin
297 FState := tsIAC_SBDATA;
298 FSubNeg := FSubNeg + c;
299 end;
300 TLNT_SE:
301 begin
302 SubReply := '';
303 case FSubType of
304 #24: //termtype
305 begin
306 if (FSubNeg <> '') and (FSubNeg[1] = #1) then
307 SubReply := #0 + FTermType;
308 end;
309 end;
310 Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);
311 FState := tsDATA;
312 end;
313 else
314 FState := tsDATA;
315 end;
316
317 else
318 FState := tsData;
319 end;
320 if Reply <> '' then
321 Sock.SendString(TLNT_IAC + Reply + c);
322 end;
323
324end;
325
326procedure TTelnetSend.Send(const Value: string);
327begin
328 Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC));
329end;
330
331function TTelnetSend.Login: Boolean;
332begin
333 Result := False;
334 if not Connect then
335 Exit;
336 Result := True;
337end;
338
339function TTelnetSend.SSHLogin: Boolean;
340begin
341 Result := False;
342 if Connect then
343 begin
344 FSock.SSL.SSLType := LT_SSHv2;
345 FSock.SSL.Username := FUsername;
346 FSock.SSL.Password := FPassword;
347 FSock.SSLDoConnect;
348 Result := FSock.LastError = 0;
349 end;
350end;
351
352procedure TTelnetSend.Logout;
353begin
354 FSock.CloseSocket;
355end;
356
357
358end.
Note: See TracBrowser for help on using the repository browser.