source: trunk/Packages/synapse/source/demo/httpproxy/ProxyThrd.pas

Last change on this file was 2, checked in by chronos, 12 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 14.3 KB
Line 
1unit ProxyThrd;
2
3interface
4
5uses
6 Classes, SyncObjs, SysUtils, windows,
7 blcksock, synsock, synautil;
8
9type
10 TServiceThread = class(TThread)
11 protected
12 procedure Execute; override;
13 public
14 constructor Create;
15 end;
16
17 TLogRec = record
18 ip: string;
19 dt: TDateTime;
20 req: string;
21 stat: string;
22 len: integer;
23 ref: string;
24 agent: string;
25 end;
26
27 TTCPHttpThrd = class(TThread)
28 private
29 csock: TSocket;
30 public
31 timeout: integer;
32 Headers: TStringList;
33 ProxyHeaders: TStringList;
34 IdStr: string;
35 LogRec: TLogRec;
36 Constructor Create (hsock:tSocket);
37 Destructor Destroy; override;
38 procedure Execute; override;
39 function RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
40 function RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
41 procedure ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
42 procedure Return502(const sock: TTCPBlockSocket; host, port: string);
43 procedure WriteAccessLog(const LogRec: TLogRec);
44 end;
45
46
47procedure InitService;
48procedure DestroyService;
49procedure Writelog(value: string);
50
51var
52 CS: TCriticalSection;
53
54implementation
55
56{==============================================================================}
57
58procedure InitService;
59begin
60 CS := TCriticalSection.create;
61end;
62
63procedure DestroyService;
64begin
65 cs.free;
66end;
67
68procedure Writelog(value: string);
69var
70 f: textFile;
71 s: string;
72begin
73 CS.Enter;
74 s := Value;
75 s := extractfilepath(ParamStr(0)) + 'access.log';
76 assignfile(f, s);
77 if fileexists(s)
78 then append(f)
79 else rewrite(f);
80 try
81 writeln(f, Value);
82 finally
83 Closefile(f);
84 CS.Leave;
85 end;
86end;
87
88{==============================================================================}
89{ TServiceThread }
90
91constructor TServiceThread.create;
92begin
93 FreeOnTerminate := false;
94 inherited create(false);
95end;
96
97procedure TServiceThread.Execute;
98var
99 sock: TTCPBlockSocket;
100 ClientSock: TSocket;
101begin
102 sock := TTCPBlockSocket.Create;
103 try
104 sock.bind('0.0.0.0','3128');
105 if sock.LastError <> 0 then
106 begin
107 WriteLog('!!! BIND failed !!!');
108 Exit;
109 end;
110 sock.setLinger(true,10000);
111 sock.listen;
112 repeat
113 if terminated then
114 break;
115 if sock.canread(1000) then
116 begin
117 //new connection... launch TTCPHttpThrd
118 ClientSock := sock.accept;
119 if sock.lastError = 0 then
120 TTCPHttpThrd.create(ClientSock);
121 end;
122 until false;
123 finally
124 sock.free;
125 end;
126end;
127
128{==============================================================================}
129
130{ TTCPHttpThrd }
131
132Constructor TTCPHttpThrd.Create(Hsock:TSocket);
133begin
134 csock := hsock;
135 Headers := TStringList.Create;
136 ProxyHeaders := TStringList.Create;
137 FreeOnTerminate:=true;
138 inherited create(false);
139end;
140
141Destructor TTCPHttpThrd.Destroy;
142begin
143 Headers.Free;
144 Proxyheaders.Free;
145 inherited Destroy;
146end;
147
148//do both direction TCP proxy tunnel. (used by CONNECT method for https proxying)
149function TTCPHttpThrd.RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
150var
151 n: integer;
152 buf: string;
153 ql, rl: TList;
154 fgsock, dgsock: TTCPBlockSocket;
155 FDSet: TFDSet;
156 FDSetSave: TFDSet;
157 TimeVal: PTimeVal;
158 TimeV: TTimeVal;
159begin
160 result := false;
161 //buffer maybe contains some pre-readed datas...
162 if fsock.LineBuffer <> '' then
163 begin
164 buf := fsock.RecvPacket(timeout);
165 if fsock.LastError <> 0 then
166 Exit;
167 dsock.SendString(buf);
168 end;
169 //begin relaying of TCP
170 ql := TList.Create;
171 rl := Tlist.create;
172 try
173 TimeV.tv_usec := (Timeout mod 1000) * 1000;
174 TimeV.tv_sec := Timeout div 1000;
175 TimeVal := @TimeV;
176 if Timeout = -1 then
177 TimeVal := nil;
178 FD_ZERO(FDSetSave);
179 FD_SET(fsock.Socket, FDSetSave);
180 FD_SET(dsock.Socket, FDSetSave);
181 FDSet := FDSetSave;
182 while synsock.Select(65535, @FDSet, nil, nil, TimeVal) > 0 do
183 begin
184 rl.clear;
185 if FD_ISSET(fsock.Socket, FDSet) then
186 rl.Add(fsock);
187 if FD_ISSET(dsock.Socket, FDSet) then
188 rl.Add(dsock);
189 for n := 0 to rl.Count - 1 do
190 begin
191 fgsock := TTCPBlockSocket(rl[n]);
192 if fgsock = fsock then
193 dgsock := dsock
194 else
195 dgsock := fsock;
196 if fgsock.WaitingData > 0 then
197 begin
198 buf := fgsock.RecvPacket(0);
199 dgsock.SendString(buf);
200 if dgsock.LastError <> 0 then
201 exit;
202 end
203 else
204 exit;
205 end;
206 FDSet := FDSetSave;
207 end;
208 finally
209 rl.free;
210 ql.free;
211 end;
212 result := true;
213end;
214
215//transmit X bytes from fsock to dsock
216function TTCPHttpThrd.RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
217var
218 sh, sl: integer;
219 n: integer;
220 buf: string;
221begin
222 result := false;
223 sh := size div c64k;
224 sl := size mod c64k;
225 for n := 1 to sh do
226 begin
227 buf := fsock.RecvBufferStr(c64k, timeout);
228 if fsock.LastError <> 0 then
229 Exit;
230 dsock.SendString(buf);
231 if dsock.LastError <> 0 then
232 Exit;
233 end;
234 if sl > 0 then
235 begin
236 buf := fsock.RecvBufferStr(sl, timeout);
237 if fsock.LastError <> 0 then
238 Exit;
239 dsock.SendString(buf);
240 if dsock.LastError <> 0 then
241 Exit;
242 end;
243 result := true;
244end;
245
246//core of proxy
247procedure TTCPHttpThrd.Execute;
248var
249 Sock: TTCPBlockSocket;
250 QSock: TTCPBlockSocket;
251 s: string;
252 method, uri, protocol: string;
253 size: integer;
254 Prot, User, Pass, Host, Port, Path, Para: string;
255 chunked: boolean;
256 status: integer;
257 proxykeep: boolean;
258 lasthost: String;
259 rprotocol: String;
260begin
261 idstr := inttostr(self.handle) + ' ';
262 sock:=TTCPBlockSocket.create;
263 Qsock:=TTCPBlockSocket.create;
264 try
265 Sock.socket:=CSock;
266 timeout := 120000;
267 lasthost := '';
268 qsock.ConvertLineEnd := true;
269 sock.ConvertLineEnd := true;
270
271 repeat
272 //read request line
273 headers.Clear;
274 proxyheaders.Clear;
275 proxykeep := false;
276 LogRec.ip := sock.GetRemoteSinIP;
277 repeat
278 s := sock.RecvString(timeout);
279 if sock.lasterror <> 0 then
280 Exit;
281 LogRec.dt := now;
282 LogRec.req := s;
283 Logrec.stat := '';
284 LogRec.len := 0;
285 Logrec.Ref := '';
286 Logrec.Agent := '';
287 until s <> '';
288 if s = '' then
289 Exit;
290 method := fetch(s, ' ');
291 if (s = '') or (method = '') then
292 Exit;
293 uri := fetch(s, ' ');
294 if uri = '' then
295 Exit;
296 protocol := fetch(s, ' ');
297 size := 0;
298 //read request headers
299 if protocol <> '' then
300 begin
301 if pos('HTTP/', protocol) <> 1 then
302 Exit;
303 repeat
304 s := sock.RecvString(Timeout);
305 if sock.lasterror <> 0 then
306 Exit;
307 if s <> '' then
308 begin
309 if pos('PROXY-', uppercase(s)) = 1 then
310 proxyHeaders.add(s)
311 else
312 Headers.add(s);
313 end;
314 if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
315 Size := StrToIntDef(SeparateRight(s, ' '), 0);
316 if Pos('PROXY-CONNECTION:', Uppercase(s)) = 1 then
317 if Pos('KEEP', Uppercase(s)) > 0 then
318 begin
319 proxykeep := true;
320 end;
321 if Pos('REFERER:', Uppercase(s)) = 1 then
322 LogRec.ref := Trim(SeparateRight(s, ' '));
323 if Pos('USER-AGENT:', Uppercase(s)) = 1 then
324 LogRec.agent := Trim(SeparateRight(s, ' '));
325 until s = '';
326 end;
327
328 if proxykeep then
329 headers.add('Connection: keep-alive')
330 else
331 headers.add('Connection: close');
332
333 s := ParseURL(uri, Prot, User, Pass, Host, Port, Path, Para);
334 Headers.Insert(0, method + ' ' + s + ' ' + protocol);
335
336 if lasthost <> host then
337 qsock.closesocket;
338 if qsock.Socket = INVALID_SOCKET then
339 begin
340 qsock.Connect(host, port);
341 if qsock.LastError <> 0 then
342 begin
343 return502(sock, host, port);
344 exit;
345 end;
346 lasthost := host;
347 end;
348
349 if method = 'CONNECT' then
350 begin
351 sock.SendString(protocol + ' 200 Connection established' + CRLF + CRLF);
352 LogRec.stat := '200';
353 WriteAccesslog(Logrec);
354 RelayTCP(sock, qsock);
355 Exit;
356 end;
357 qsock.SendString(headers.text + CRLF);
358
359 //upload data from client to server if needed.
360 if size > 0 then
361 begin
362 if not RelaySock(sock, qsock, size) then
363 exit;
364 end;
365
366 //read response line
367 repeat
368 headers.Clear;
369 s := qsock.RecvString(timeout);
370 if qsock.lasterror <> 0 then
371 Exit;
372 if s = '' then
373 Exit;
374 headers.Add(s);
375 rprotocol := fetch(s, ' ');
376 status := StrToIntDef(separateleft(s, ' '), 0);
377 if status = 100 then
378 begin
379 sock.SendString(rprotocol + ' ' + s + CRLF);
380 repeat
381 s := qSock.RecvString(Timeout);
382 if qSock.LastError = 0 then
383 sock.SendString(s + CRLF);
384 until (s = '') or (qSock.LastError <> 0);
385 end;
386 until status <> 100;
387
388
389 //read response headers
390 if pos('HTTP/', rprotocol) <> 1 then
391 Exit;
392 LogRec.stat := IntToStr(status);
393 size := -1;
394 chunked := false;
395 //read response headers
396 repeat
397 s := qsock.RecvString(Timeout);
398 if qsock.lasterror <> 0 then
399 Exit;
400 if s <> '' then
401 Headers.add(s);
402 if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
403 Size := StrToIntDef(SeparateRight(s, ' '), 0);
404 if Pos('TRANSFER-ENCODING:', uppercase(s)) = 1 then
405 chunked:=Pos('CHUNKED', uppercase(s)) > 0;
406 if Pos('CONNECTION:', uppercase(s)) = 1 then
407 if Pos('CLOSE', uppercase(s)) > 0 then
408 proxyKeep := False;
409 until s = '';
410
411 if (not(chunked)) and (size = -1) then
412 proxyKeep := false;
413
414 if proxykeep and (protocol <> 'HTTP/1.1') then
415 proxykeep := false;
416
417 sock.SendString(headers.text + CRLF);
418
419 if method = 'HEAD' then
420 begin
421 LogRec.len := 0;
422 end
423 else
424 begin
425 if size > 0 then
426 begin
427 //identity kodovani
428 if not RelaySock(qsock, sock, size) then
429 exit;
430 LogRec.len := Size;
431 end
432 else
433 begin
434 if chunked then
435 begin
436 repeat
437 repeat
438 s := qSock.RecvString(Timeout);
439 if qSock.LastError = 0 then
440 sock.SendString(s + CRLF);
441 until (s <> '') or (qSock.LastError <> 0);
442 if qSock.LastError <> 0 then
443 Break;
444 s := Trim(SeparateLeft(s, ' '));
445 s := Trim(SeparateLeft(s, ';'));
446 Size := StrToIntDef('$' + s, 0);
447 LogRec.len := LogRec.len + Size;
448 if Size = 0 then
449 begin
450 repeat
451 s := qSock.RecvString(Timeout);
452 if qSock.LastError = 0 then
453 sock.SendString(s + CRLF);
454 until (s = '') or (qSock.LastError <> 0);
455 Break;
456 end;
457 if not RelaySock(qsock, sock, size) then
458 break;
459 until False;
460 end
461 else
462 begin
463 if size = -1 then
464 if method = 'GET' then
465 if (status div 100) = 2 then
466 begin
467 while qsock.LastError = 0 do
468 begin
469 s := qsock.RecvPacket(timeout);
470 if qsock.LastError = 0 then
471 sock.SendString(s);
472 LogRec.len := LogRec.len + length(s);
473 end;
474 end;
475 end;
476 end;
477 end;
478 //done
479 WriteAccesslog(Logrec);
480 if (qsock.LastError <> 0) or (sock.LastError <> 0) then
481 Exit;
482 sleep(1);
483 until not proxykeep;
484 //finish with connection
485 finally
486 sock.Free;
487 Qsock.Free;
488 end;
489end;
490
491procedure TTCPHttpThrd.ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
492begin
493 sock.sendstring('HTTP/1.0 ' + stat + CRLF);
494 sock.sendstring('Content-type: text/html' + CRLF);
495 sock.sendstring('Content-length: ' + Inttostr(length(value)) + CRLF);
496 sock.sendstring('proxy-Connection: close' + CRLF);
497 sock.sendstring(CRLF);
498 sock.sendstring(value);
499end;
500
501procedure TTCPHttpThrd.Return502(const sock: TTCPBlockSocket; host, port: string);
502var
503 l: TStringlist;
504begin
505 l := TStringList.Create;
506 try
507 l.Add('<html>');
508 l.Add('<head><title>Bad address!</title></head>');
509 l.Add('<body>');
510 l.Add('<H1>Bad address!</H1>');
511 l.Add('<P>');
512 l.Add('Unable to connect with: ' + host + ':' + port);
513 l.Add('<P>');
514 l.Add('Requested address is bad, or server is not accessible now.');
515 l.Add('<P>');
516 l.Add('<H2>Error 502</H2>');
517 l.Add('<P>');
518 l.Add('</body>');
519 l.Add('</html>');
520 ReturnHTML(sock, l.text, '502');
521 finally
522 l.free;
523 end;
524end;
525
526//write Apache compatible access log
527procedure TTCPHttpThrd.WriteAccessLog(const LogRec: TLogRec);
528var
529 day, month, year: word;
530 s: string;
531const
532 MNames: array[1..12] of string =
533 ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
534 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
535begin
536 Decodedate(LogRec.dt,year, month, day);
537 s := Format('%.2d', [day]) + '/' + MNames[month] + '/' + IntToStr(year);
538 s := '[' + s + FormatDateTime(':hh:nn:ss', LogRec.dt) + ' ' + TimeZone + ']';
539 s := LogRec.ip + ' - - ' + s + ' "' + LogRec.req + '"';
540 if LogRec.stat = '' then
541 s := s + ' -'
542 else
543 s := s + ' ' + LogRec.Stat;
544 if LogRec.len = 0 then
545 s := s + ' -'
546 else
547 s := s + ' ' + IntToStr(LogRec.len);
548 if LogRec.Ref = '' then
549 s := s + ' "-"'
550 else
551 s := s + ' "' + LogRec.Ref + '"';
552 if LogRec.Agent = '' then
553 s := s + ' "-"'
554 else
555 s := s + ' "' + LogRec.Agent + '"';
556 Writelog(s);
557end;
558
559end.
Note: See TracBrowser for help on using the repository browser.