source: trunk/Packages/synapse/source/lib/tlntsend.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 11.1 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.003.001 |
3|==============================================================================|
4| Content: TELNET and SSH2 client |
5|==============================================================================|
6| Copyright (c)1999-2010, 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-2010. |
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
55{$IFDEF UNICODE}
56 {$WARN IMPLICIT_STRING_CAST OFF}
57 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
58{$ENDIF}
59
60unit tlntsend;
61
62interface
63
64uses
65 SysUtils, Classes,
66 blcksock, synautil;
67
68const
69 cTelnetProtocol = '23';
70 cSSHProtocol = '22';
71
72 TLNT_EOR = #239;
73 TLNT_SE = #240;
74 TLNT_NOP = #241;
75 TLNT_DATA_MARK = #242;
76 TLNT_BREAK = #243;
77 TLNT_IP = #244;
78 TLNT_AO = #245;
79 TLNT_AYT = #246;
80 TLNT_EC = #247;
81 TLNT_EL = #248;
82 TLNT_GA = #249;
83 TLNT_SB = #250;
84 TLNT_WILL = #251;
85 TLNT_WONT = #252;
86 TLNT_DO = #253;
87 TLNT_DONT = #254;
88 TLNT_IAC = #255;
89
90type
91 {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.}
92 TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT,
93 tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC);
94
95 {:@abstract(Class with implementation of Telnet/SSH script client.)
96
97 Note: Are you missing properties for specify server address and port? Look to
98 parent @link(TSynaClient) too!}
99 TTelnetSend = class(TSynaClient)
100 private
101 FSock: TTCPBlockSocket;
102 FBuffer: Ansistring;
103 FState: TTelnetState;
104 FSessionLog: Ansistring;
105 FSubNeg: Ansistring;
106 FSubType: Ansichar;
107 FTermType: Ansistring;
108 function Connect: Boolean;
109 function Negotiate(const Buf: Ansistring): Ansistring;
110 procedure FilterHook(Sender: TObject; var Value: AnsiString);
111 public
112 constructor Create;
113 destructor Destroy; override;
114
115 {:Connects to Telnet server.}
116 function Login: Boolean;
117
118 {:Connects to SSH2 server and login by Username and Password properties.
119
120 You must use some of SSL plugins with SSH support. For exammple CryptLib.}
121 function SSHLogin: Boolean;
122
123 {:Logout from telnet server.}
124 procedure Logout;
125
126 {:Send this data to telnet server.}
127 procedure Send(const Value: string);
128
129 {:Reading data from telnet server until Value is readed. If it is not readed
130 until timeout, result is @false. Otherwise result is @true.}
131 function WaitFor(const Value: string): Boolean;
132
133 {:Read data terminated by terminator from telnet server.}
134 function RecvTerminated(const Terminator: string): string;
135
136 {:Read string from telnet server.}
137 function RecvString: string;
138 published
139 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
140 property Sock: TTCPBlockSocket read FSock;
141
142 {:all readed datas in this session (from connect) is stored in this large
143 string.}
144 property SessionLog: Ansistring read FSessionLog write FSessionLog;
145
146 {:Terminal type indentification. By default is 'SYNAPSE'.}
147 property TermType: Ansistring read FTermType write FTermType;
148 end;
149
150implementation
151
152constructor TTelnetSend.Create;
153begin
154 inherited Create;
155 FSock := TTCPBlockSocket.Create;
156 FSock.Owner := self;
157 FSock.OnReadFilter := FilterHook;
158 FTimeout := 60000;
159 FTargetPort := cTelnetProtocol;
160 FSubNeg := '';
161 FSubType := #0;
162 FTermType := 'SYNAPSE';
163end;
164
165destructor TTelnetSend.Destroy;
166begin
167 FSock.Free;
168 inherited Destroy;
169end;
170
171function TTelnetSend.Connect: Boolean;
172begin
173 // Do not call this function! It is calling by LOGIN method!
174 FBuffer := '';
175 FSessionLog := '';
176 FState := tsDATA;
177 FSock.CloseSocket;
178 FSock.LineBuffer := '';
179 FSock.Bind(FIPInterface, cAnyPort);
180 FSock.Connect(FTargetHost, FTargetPort);
181 Result := FSock.LastError = 0;
182end;
183
184function TTelnetSend.RecvTerminated(const Terminator: string): string;
185begin
186 Result := FSock.RecvTerminated(FTimeout, Terminator);
187end;
188
189function TTelnetSend.RecvString: string;
190begin
191 Result := FSock.RecvTerminated(FTimeout, CRLF);
192end;
193
194function TTelnetSend.WaitFor(const Value: string): Boolean;
195begin
196 Result := FSock.RecvTerminated(FTimeout, Value) <> '';
197end;
198
199procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString);
200begin
201 Value := Negotiate(Value);
202 FSessionLog := FSessionLog + Value;
203end;
204
205function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring;
206var
207 n: integer;
208 c: Ansichar;
209 Reply: Ansistring;
210 SubReply: Ansistring;
211begin
212 Result := '';
213 for n := 1 to Length(Buf) do
214 begin
215 c := Buf[n];
216 Reply := '';
217 case FState of
218 tsData:
219 if c = TLNT_IAC then
220 FState := tsIAC
221 else
222 Result := Result + c;
223
224 tsIAC:
225 case c of
226 TLNT_IAC:
227 begin
228 FState := tsData;
229 Result := Result + TLNT_IAC;
230 end;
231 TLNT_WILL:
232 FState := tsIAC_WILL;
233 TLNT_WONT:
234 FState := tsIAC_WONT;
235 TLNT_DONT:
236 FState := tsIAC_DONT;
237 TLNT_DO:
238 FState := tsIAC_DO;
239 TLNT_EOR:
240 FState := tsDATA;
241 TLNT_SB:
242 begin
243 FState := tsIAC_SB;
244 FSubType := #0;
245 FSubNeg := '';
246 end;
247 else
248 FState := tsData;
249 end;
250
251 tsIAC_WILL:
252 begin
253 case c of
254 #3: //suppress GA
255 Reply := TLNT_DO;
256 else
257 Reply := TLNT_DONT;
258 end;
259 FState := tsData;
260 end;
261
262 tsIAC_WONT:
263 begin
264 Reply := TLNT_DONT;
265 FState := tsData;
266 end;
267
268 tsIAC_DO:
269 begin
270 case c of
271 #24: //termtype
272 Reply := TLNT_WILL;
273 else
274 Reply := TLNT_WONT;
275 end;
276 FState := tsData;
277 end;
278
279 tsIAC_DONT:
280 begin
281 Reply := TLNT_WONT;
282 FState := tsData;
283 end;
284
285 tsIAC_SB:
286 begin
287 FSubType := c;
288 FState := tsIAC_SBDATA;
289 end;
290
291 tsIAC_SBDATA:
292 begin
293 if c = TLNT_IAC then
294 FState := tsSBDATA_IAC
295 else
296 FSubNeg := FSubNeg + c;
297 end;
298
299 tsSBDATA_IAC:
300 case c of
301 TLNT_IAC:
302 begin
303 FState := tsIAC_SBDATA;
304 FSubNeg := FSubNeg + c;
305 end;
306 TLNT_SE:
307 begin
308 SubReply := '';
309 case FSubType of
310 #24: //termtype
311 begin
312 if (FSubNeg <> '') and (FSubNeg[1] = #1) then
313 SubReply := #0 + FTermType;
314 end;
315 end;
316 Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);
317 FState := tsDATA;
318 end;
319 else
320 FState := tsDATA;
321 end;
322
323 else
324 FState := tsData;
325 end;
326 if Reply <> '' then
327 Sock.SendString(TLNT_IAC + Reply + c);
328 end;
329
330end;
331
332procedure TTelnetSend.Send(const Value: string);
333begin
334 Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC));
335end;
336
337function TTelnetSend.Login: Boolean;
338begin
339 Result := False;
340 if not Connect then
341 Exit;
342 Result := True;
343end;
344
345function TTelnetSend.SSHLogin: Boolean;
346begin
347 Result := False;
348 if Connect then
349 begin
350 FSock.SSL.SSLType := LT_SSHv2;
351 FSock.SSL.Username := FUsername;
352 FSock.SSL.Password := FPassword;
353 FSock.SSLDoConnect;
354 Result := FSock.LastError = 0;
355 end;
356end;
357
358procedure TTelnetSend.Logout;
359begin
360 FSock.CloseSocket;
361end;
362
363
364end.
Note: See TracBrowser for help on using the repository browser.