1 |
{lsocket.pas}
|
2 |
|
3 |
{socket code by plugwash}
|
4 |
|
5 |
{ Copyright (C) 2005 Bas Steendijk and Peter Green
|
6 |
For conditions of distribution and use, see copyright notice in zlib_license.txt
|
7 |
which is included in the package
|
8 |
----------------------------------------------------------------------------- }
|
9 |
{
|
10 |
changes by plugwash (20030728)
|
11 |
* created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it
|
12 |
* changed tlasio to tlasio
|
13 |
* split fdhandle into fdhandlein and fdhandleout
|
14 |
* i now use fdsrmaster and fdswmaster instead of rebuilding the lists every loop
|
15 |
* split lsocket.pas into lsocket.pas and lcore.pas
|
16 |
|
17 |
|
18 |
changes by beware (20030903)
|
19 |
* added getxaddr, getxport (local addr, port, as string)
|
20 |
* added getpeername, remote addr+port as binary
|
21 |
* added htons and htonl functions (endian swap, same interface as windows API)
|
22 |
|
23 |
beware (20030905)
|
24 |
* if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose)
|
25 |
* (lcore) if closing the fd's in internalclose, set fds to -1 because closing an fd makes it invalid
|
26 |
|
27 |
beware (20030927)
|
28 |
* fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check
|
29 |
|
30 |
beware (20031017)
|
31 |
* added getpeeraddr, getpeerport, remote addr+port as string
|
32 |
}
|
33 |
|
34 |
|
35 |
unit lsocket;
|
36 |
{$ifdef fpc}
|
37 |
{$mode delphi}
|
38 |
{$endif}
|
39 |
|
40 |
{$include lcoreconfig.inc}
|
41 |
|
42 |
interface
|
43 |
uses
|
44 |
sysutils,
|
45 |
{$ifdef mswindows}
|
46 |
windows,winsock,
|
47 |
{$else}
|
48 |
|
49 |
{$ifdef VER1_0}
|
50 |
linux,
|
51 |
{$else}
|
52 |
baseunix,unix,unixutil,
|
53 |
{$endif}
|
54 |
sockets,
|
55 |
{$endif}
|
56 |
classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync;
|
57 |
|
58 |
{$ifdef ipv6}
|
59 |
const
|
60 |
v4listendefault:boolean=false;
|
61 |
{$endif}
|
62 |
|
63 |
|
64 |
type
|
65 |
sunB = packed record
|
66 |
s_b1, s_b2, s_b3, s_b4: byte;
|
67 |
end;
|
68 |
|
69 |
SunW = packed record
|
70 |
s_w1, s_w2: word;
|
71 |
end;
|
72 |
|
73 |
TInAddr = packed record
|
74 |
case integer of
|
75 |
0: (S_un_b: SunB);
|
76 |
1: (S_un_w: SunW);
|
77 |
2: (S_addr: cardinal);
|
78 |
end;
|
79 |
|
80 |
type
|
81 |
TLsocket = class(tlasio)
|
82 |
public
|
83 |
//a: string;
|
84 |
|
85 |
inAddr : TInetSockAddrV;
|
86 |
|
87 |
biniplist:tbiniplist;
|
88 |
trymoreips:boolean;
|
89 |
currentip:integer;
|
90 |
connecttimeout:tltimer;
|
91 |
|
92 |
{ inAddrSize:integer;}
|
93 |
|
94 |
//host : THostentry ;
|
95 |
|
96 |
//mainthread : boolean ; //for debugging only
|
97 |
addr:thostname;
|
98 |
port:ansistring;
|
99 |
localaddr:thostname;
|
100 |
localport:ansistring;
|
101 |
proto:ansistring;
|
102 |
udp,dgram:boolean;
|
103 |
listenqueue:integer;
|
104 |
|
105 |
onconnecttryip:procedure(sender:tobject; const ip:tbinip) of object;
|
106 |
|
107 |
{$ifdef secondlistener}
|
108 |
secondlistener:tlsocket;
|
109 |
lastsessionfromsecond:boolean;
|
110 |
procedure secondaccepthandler(sender:tobject;error:word);
|
111 |
procedure internalclose(error:word);override;
|
112 |
{$endif}
|
113 |
function getaddrsize:integer;
|
114 |
procedure connect; virtual;
|
115 |
procedure realconnect;
|
116 |
procedure bindsocket;
|
117 |
procedure listen;
|
118 |
function accept : longint;
|
119 |
function sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer; virtual;
|
120 |
function receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer; virtual;
|
121 |
|
122 |
procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
|
123 |
function send(data:pointer;len:integer):integer;override;
|
124 |
procedure sendstr(const str : tbufferstring);override;
|
125 |
function Receive(Buf:Pointer;BufSize:integer):integer; override;
|
126 |
function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual;
|
127 |
procedure getXaddrbin(var binip:tbinip); virtual;
|
128 |
procedure getpeeraddrbin(var binip:tbinip); virtual;
|
129 |
function getXaddr:thostname; virtual;
|
130 |
function getpeeraddr:thostname; virtual;
|
131 |
function getXport:ansistring; virtual;
|
132 |
function getpeerport:ansistring; virtual;
|
133 |
constructor Create(AOwner: TComponent); override;
|
134 |
|
135 |
//this one has to be kept public for now because lcorewsaasyncselect calls it
|
136 |
procedure connectionfailedhandler(error:word);
|
137 |
|
138 |
{public in tlasio, and can't be private in both places, so should be public here.
|
139 |
fixes delphi warning --beware}
|
140 |
{$ifdef mswindows}
|
141 |
procedure myfdclose(fd : integer); override;
|
142 |
function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;
|
143 |
function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override;
|
144 |
{$endif}
|
145 |
|
146 |
private
|
147 |
{$ifdef ipv6}
|
148 |
isv6socket : boolean; //identifies if the socket is v6, set by bindsocket
|
149 |
{$endif}
|
150 |
procedure taskcallconnectionfailedhandler(wparam,lparam : longint);
|
151 |
|
152 |
procedure connecttimeouthandler(sender:tobject);
|
153 |
procedure connectsuccesshandler;
|
154 |
end;
|
155 |
tsocket=longint; // for compatibility with twsocket
|
156 |
|
157 |
twsocket=tlsocket; {easy}
|
158 |
|
159 |
|
160 |
const
|
161 |
TCP_NODELAY=1;
|
162 |
IPPROTO_TCP=6;
|
163 |
|
164 |
implementation
|
165 |
{$include unixstuff.inc}
|
166 |
|
167 |
|
168 |
function tlsocket.getaddrsize:integer;
|
169 |
begin
|
170 |
result := inaddrsize(inaddr);
|
171 |
end;
|
172 |
|
173 |
//I used to use the system versions of these from within lsocket (which has
|
174 |
//functions whose name clashes with them) by using sockets.* and but I can't do
|
175 |
//that anymore since in some cases connect is now provided by unixstuff.inc
|
176 |
//hence these wrapper functions --plugwash
|
177 |
{$ifndef mswindows}
|
178 |
function system_Connect(Sock: LongInt;const Addr;Addrlen: LongInt):Boolean;
|
179 |
begin
|
180 |
result := connect(sock,addr,addrlen);
|
181 |
end;
|
182 |
function system_SendTo(Sock: LongInt; const Buf;BufLen: LongInt;Flags: LongInt;var Addr;AddrLen: LongInt):LongInt;
|
183 |
begin
|
184 |
result := sendto(sock,buf,buflen,flags,addr,addrlen);
|
185 |
end;
|
186 |
function system_getpeername(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
|
187 |
begin
|
188 |
result := getpeername(sock,addr,addrlen);
|
189 |
end;
|
190 |
function system_listen(Sock: LongInt; MaxConnect: LongInt):Boolean;
|
191 |
begin
|
192 |
result := listen(sock,maxconnect);
|
193 |
end;
|
194 |
function system_Accept(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
|
195 |
begin
|
196 |
result := accept(sock,addr,addrlen);
|
197 |
end;
|
198 |
{$endif}
|
199 |
|
200 |
procedure tlsocket.realconnect;
|
201 |
var
|
202 |
a,b:integer;
|
203 |
iptemp:tbinip;
|
204 |
begin
|
205 |
iptemp := biniplist_get(biniplist,currentip);
|
206 |
//writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);
|
207 |
if assigned(onconnecttryip) then onconnecttryip(self,iptemp);
|
208 |
makeinaddrv(iptemp,port,inaddr);
|
209 |
inc(currentip);
|
210 |
if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;
|
211 |
|
212 |
udp := false;
|
213 |
if (uppercase(proto) = 'UDP') then begin
|
214 |
b := IPPROTO_UDP;
|
215 |
a := SOCK_DGRAM;
|
216 |
udp := true;
|
217 |
dgram := true;
|
218 |
end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin
|
219 |
b := IPPROTO_TCP;
|
220 |
a := SOCK_STREAM;
|
221 |
dgram := false;
|
222 |
end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin
|
223 |
b := strtointdef(proto,IPPROTO_ICMP);
|
224 |
a := SOCK_RAW;
|
225 |
dgram := true;
|
226 |
end else begin
|
227 |
raise ESocketException.create('unrecognised protocol');
|
228 |
end;
|
229 |
|
230 |
a := Socket(inaddr.inaddr.family,a,b);
|
231 |
//writeln(ord(inaddr.inaddr.family));
|
232 |
if a = -1 then begin
|
233 |
//unable to create socket, fire an error event (better to use an error event
|
234 |
//to avoid poor interaction with multilistener stuff.
|
235 |
//a socket value of -2 is a special value to say there is no socket but
|
236 |
//we want internalclose to act as if there was
|
237 |
fdhandlein := -2;
|
238 |
fdhandleout := -2;
|
239 |
tltask.create(taskcallconnectionfailedhandler,self,{$ifdef mswindows}wsagetlasterror{$else}socketerror{$endif},0);
|
240 |
exit;
|
241 |
end;
|
242 |
try
|
243 |
dup(a);
|
244 |
bindsocket;
|
245 |
if dgram then begin
|
246 |
{$ifndef mswindows}
|
247 |
SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
|
248 |
{$else}
|
249 |
SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
|
250 |
{$endif}
|
251 |
state := wsconnected;
|
252 |
if assigned(onsessionconnected) then onsessionconnected(self,0);
|
253 |
|
254 |
eventcore.rmasterset(fdhandlein,false);
|
255 |
eventcore.wmasterclr(fdhandleout);
|
256 |
end else begin
|
257 |
state :=wsconnecting;
|
258 |
{$ifdef mswindows}
|
259 |
//writeln(inaddr.inaddr.port);
|
260 |
winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
|
261 |
{$else}
|
262 |
system_Connect(fdhandlein,inADDR,getaddrsize);
|
263 |
{$endif}
|
264 |
eventcore.rmasterset(fdhandlein,false);
|
265 |
eventcore.wmasterset(fdhandleout);
|
266 |
if trymoreips then connecttimeout.enabled := true;
|
267 |
end;
|
268 |
//sendq := '';
|
269 |
except
|
270 |
on e: exception do begin
|
271 |
fdcleanup;
|
272 |
raise; //reraise the exception
|
273 |
end;
|
274 |
end;
|
275 |
|
276 |
end;
|
277 |
|
278 |
procedure tlsocket.connecttimeouthandler(sender:tobject);
|
279 |
begin
|
280 |
connecttimeout.enabled := false;
|
281 |
destroying := true; //hack to not cause handler to trigger
|
282 |
internalclose(0);
|
283 |
destroying := false;
|
284 |
realconnect;
|
285 |
end;
|
286 |
|
287 |
|
288 |
|
289 |
|
290 |
procedure tlsocket.connect;
|
291 |
begin
|
292 |
if state <> wsclosed then close;
|
293 |
//prevtime := 0;
|
294 |
if isbiniplist(addr) then biniplist := addr else biniplist := forwardlookuplist(addr,0);
|
295 |
if biniplist_getcount(biniplist) = 0 then raise exception.create('unable to resolve '+addr);
|
296 |
|
297 |
//makeinaddrv(addr,port,inaddr);
|
298 |
|
299 |
currentip := 0;
|
300 |
if not assigned(connecttimeout) then begin
|
301 |
connecttimeout := tltimer.create(self);
|
302 |
connecttimeout.ontimer := connecttimeouthandler;
|
303 |
connecttimeout.interval := 5000;
|
304 |
connecttimeout.enabled := false;
|
305 |
end;
|
306 |
realconnect;
|
307 |
end;
|
308 |
|
309 |
procedure tlsocket.sendstr(const str : tbufferstring);
|
310 |
begin
|
311 |
if dgram then begin
|
312 |
send(@str[1],length(str))
|
313 |
end else begin
|
314 |
inherited sendstr(str);
|
315 |
end;
|
316 |
end;
|
317 |
|
318 |
function tlsocket.send(data:pointer;len:integer):integer;
|
319 |
begin
|
320 |
if dgram then begin
|
321 |
// writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes');
|
322 |
result := sendto(inaddr,getaddrsize,data,len);
|
323 |
|
324 |
// writeln('send result ',result);
|
325 |
// writeln('errno',errno);
|
326 |
end else begin
|
327 |
result := inherited send(data,len);
|
328 |
end;
|
329 |
end;
|
330 |
|
331 |
|
332 |
function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
|
333 |
begin
|
334 |
if dgram then begin
|
335 |
{$ifdef secondlistener}
|
336 |
if lastsessionfromsecond then begin
|
337 |
result := secondlistener.receive(buf,bufsize);
|
338 |
lastsessionfromsecond := false;
|
339 |
end else
|
340 |
{$endif}
|
341 |
result := myfdread(self.fdhandlein,buf^,bufsize);
|
342 |
end else begin
|
343 |
result := inherited receive(buf,bufsize);
|
344 |
end;
|
345 |
end;
|
346 |
|
347 |
procedure tlsocket.bindsocket;
|
348 |
var
|
349 |
inAddrtemp:TInetSockAddrV;
|
350 |
inAddrtempx:{$ifdef mswindows}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
|
351 |
inaddrtempsize:integer;
|
352 |
begin
|
353 |
try
|
354 |
if (localaddr <> '') or (localport <> '') then begin
|
355 |
if localaddr = '' then begin
|
356 |
{$ifdef ipv6}
|
357 |
if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
|
358 |
{$endif}
|
359 |
localaddr := '0.0.0.0';
|
360 |
end;
|
361 |
//gethostbyname(localaddr,host);
|
362 |
inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp);
|
363 |
{$ifdef ipv6}
|
364 |
isv6socket := (inaddrtemp.inaddr.family = AF_INET6);
|
365 |
{$endif}
|
366 |
If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef mswindows}0{$else}true{$endif} Then begin
|
367 |
state := wsclosed;
|
368 |
lasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif};
|
369 |
raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
|
370 |
end;
|
371 |
state := wsbound;
|
372 |
end;
|
373 |
except
|
374 |
on e: exception do begin
|
375 |
fdcleanup;
|
376 |
raise; //reraise the exception
|
377 |
end;
|
378 |
end;
|
379 |
end;
|
380 |
|
381 |
procedure tlsocket.listen;
|
382 |
var
|
383 |
{$ifndef mswindows}
|
384 |
yes,no:longint;
|
385 |
{$endif}
|
386 |
socktype:integer;
|
387 |
biniptemp:tbinip;
|
388 |
origaddr:thostname;
|
389 |
begin
|
390 |
if state <> wsclosed then close;
|
391 |
udp := uppercase(proto) = 'UDP';
|
392 |
if udp then begin
|
393 |
socktype := SOCK_DGRAM;
|
394 |
dgram := true;
|
395 |
end else socktype := SOCK_STREAM;
|
396 |
origaddr := addr;
|
397 |
|
398 |
if addr = '' then begin
|
399 |
{$ifdef ipv6}
|
400 |
//writeln('ipv6 is defined');
|
401 |
if not v4listendefault then begin
|
402 |
//writeln('setting addr to ::');
|
403 |
addr := '::';
|
404 |
end else
|
405 |
{$endif}
|
406 |
addr := '0.0.0.0';
|
407 |
end;
|
408 |
if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10);
|
409 |
addr := ipbintostr(biniptemp);
|
410 |
//writeln('after ipbintostr call addr =',addr);
|
411 |
//writeln('biniptemp.family =',biniptemp.family);
|
412 |
//writeln('AF_INET6=',AF_INET6);
|
413 |
//writeln('PF_INET6=',PF_INET6);
|
414 |
//writeln('AF_INET=',AF_INET);
|
415 |
//writeln('PF_INET=',PF_INET);
|
416 |
|
417 |
fdhandlein := socket(biniptemp.family,socktype,0);
|
418 |
{$ifdef ipv6}
|
419 |
if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
|
420 |
{writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead');}
|
421 |
addr := '0.0.0.0';
|
422 |
biniptemp := ipstrtobinf(addr);
|
423 |
fdhandlein := socket(PF_INET,socktype,0);
|
424 |
end;
|
425 |
{$endif}
|
426 |
|
427 |
if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef mswindows}+' error='+inttostr(wsagetlasterror){$endif});
|
428 |
dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
|
429 |
//eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
|
430 |
state := wsclosed; // then set this back as it was an undesired side effect of dup
|
431 |
|
432 |
try
|
433 |
{$ifndef mswindows}
|
434 |
yes := $01010101; {Copied this from existing code. Value is empiric,
|
435 |
but works. (yes=true<>0) }
|
436 |
no := 0;
|
437 |
|
438 |
if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
|
439 |
raise ESocketException.create('unable to set SO_REUSEADDR socket option');
|
440 |
end;
|
441 |
//writeln('addr=',addr);
|
442 |
//writeln('setting IPV6_V6ONLY option to 0');
|
443 |
//allow v4 connections on v6 sockets
|
444 |
if biniptemp.family = af_inet6 then begin
|
445 |
if SetSocketOptions(fdhandlein, IPPROTO_IPV6,IPV6_V6ONLY,no,sizeof(no))=-1 then begin
|
446 |
writeln(IPPROTO_IPV6);
|
447 |
writeln(IPV6_V6ONLY);
|
448 |
raise ESocketException.create('unable to set IPV6_V6ONLY socket option error='+inttostr(socketerror));
|
449 |
|
450 |
end;
|
451 |
end;
|
452 |
{$else}
|
453 |
SetSockOpt(fdhandlein, SOL_SOCKET, SO_REUSEADDR, 'TRUE', Length('TRUE'));
|
454 |
|
455 |
{$endif}
|
456 |
localaddr := addr;
|
457 |
localport := port;
|
458 |
bindsocket;
|
459 |
|
460 |
if not udp then begin
|
461 |
{!!! allow custom queue length? default 5}
|
462 |
if listenqueue = 0 then listenqueue := 5;
|
463 |
If {$ifdef mswindows}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef mswindows}0{$else}true{$endif} Then raise
|
464 |
esocketexception.create('unable to listen');
|
465 |
state := wsListening;
|
466 |
end else begin
|
467 |
{$ifndef mswindows}
|
468 |
SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
|
469 |
{$else}
|
470 |
SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
|
471 |
{$endif}
|
472 |
state := wsconnected;
|
473 |
end;
|
474 |
|
475 |
{$ifdef secondlistener}
|
476 |
//listening on ::. try to listen on 0.0.0.0 as well for platforms which don't already do that
|
477 |
if addr = '::' then begin
|
478 |
secondlistener := tlsocket.create(nil);
|
479 |
secondlistener.proto := proto;
|
480 |
secondlistener.addr := '0.0.0.0';
|
481 |
secondlistener.port := port;
|
482 |
if udp then begin
|
483 |
secondlistener.ondataavailable := secondaccepthandler;
|
484 |
end else begin
|
485 |
secondlistener.onsessionAvailable := secondaccepthandler;
|
486 |
end;
|
487 |
try
|
488 |
secondlistener.listen;
|
489 |
except
|
490 |
secondlistener.destroy;
|
491 |
secondlistener := nil;
|
492 |
end;
|
493 |
end;
|
494 |
{$endif}
|
495 |
finally
|
496 |
if state = wsclosed then begin
|
497 |
if fdhandlein >= 0 then begin
|
498 |
{one *can* get here without fd -beware}
|
499 |
eventcore.rmasterclr(fdhandlein);
|
500 |
myfdclose(fdhandlein); // we musnt leak file descriptors
|
501 |
eventcore.setfdreverse(fdhandlein,nil);
|
502 |
fdhandlein := -1;
|
503 |
end;
|
504 |
end else begin
|
505 |
eventcore.rmasterset(fdhandlein,not udp);
|
506 |
end;
|
507 |
if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
|
508 |
end;
|
509 |
//writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein);
|
510 |
end;
|
511 |
|
512 |
{$ifdef secondlistener}
|
513 |
procedure tlsocket.internalclose(error:word);
|
514 |
begin
|
515 |
if assigned(secondlistener) then begin
|
516 |
secondlistener.destroy;
|
517 |
secondlistener := nil;
|
518 |
end;
|
519 |
inherited internalclose(error);
|
520 |
end;
|
521 |
|
522 |
procedure tlsocket.secondaccepthandler;
|
523 |
begin
|
524 |
lastsessionfromsecond := true;
|
525 |
if udp then begin
|
526 |
ondataavailable(self,error);
|
527 |
end else begin
|
528 |
if assigned(onsessionavailable) then onsessionavailable(self,error);
|
529 |
end;
|
530 |
end;
|
531 |
{$endif}
|
532 |
|
533 |
function tlsocket.accept : longint;
|
534 |
var
|
535 |
FromAddrSize : LongInt; // i don't really know what to do with these at this
|
536 |
FromAddr : TInetSockAddrV; // at this point time will tell :)
|
537 |
a,acceptlasterror:integer;
|
538 |
begin
|
539 |
{$ifdef secondlistener}
|
540 |
if (lastsessionfromsecond) then begin
|
541 |
lastsessionfromsecond := false;
|
542 |
result := secondlistener.accept;
|
543 |
exit;
|
544 |
end;
|
545 |
{$endif}
|
546 |
|
547 |
FromAddrSize := Sizeof(FromAddr);
|
548 |
{$ifdef mswindows}
|
549 |
result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
|
550 |
{$else}
|
551 |
result := system_accept(fdhandlein,fromaddr,fromaddrsize);
|
552 |
{$endif}
|
553 |
|
554 |
if (result = -1) then acceptlasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif} else acceptlasterror := 0;
|
555 |
|
556 |
//now we have accepted one request start monitoring for more again
|
557 |
eventcore.rmasterset(fdhandlein,true);
|
558 |
|
559 |
if result = -1 then begin
|
560 |
raise esocketexception.create('error '+inttostr(acceptlasterror)+' while accepting');
|
561 |
end;
|
562 |
if result > absolutemaxs then begin
|
563 |
myfdclose(result);
|
564 |
a := result;
|
565 |
{ result := -1;}
|
566 |
raise esocketexception.create('file descriptor out of range: '+inttostr(a));
|
567 |
end;
|
568 |
end;
|
569 |
|
570 |
|
571 |
function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer;
|
572 |
var
|
573 |
{$ifdef ipv6}
|
574 |
realdest : tinetsockaddrv;
|
575 |
biniptemp : tbinip;
|
576 |
{$endif}
|
577 |
destx : {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif};
|
578 |
|
579 |
begin
|
580 |
{$ifdef secondlistener}
|
581 |
if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin
|
582 |
result := secondlistener.sendto(dest,destlen,data,len);
|
583 |
exit;
|
584 |
end;
|
585 |
{$endif}
|
586 |
{$ifdef ipv6}
|
587 |
if isv6socket then begin
|
588 |
biniptemp := inaddrvtobinip(dest);
|
589 |
converttov6(biniptemp);
|
590 |
destlen := makeinaddrv(biniptemp,inttostr(ntohs(dest.InAddr.port)),realdest);
|
591 |
destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@realdest)
|
592 |
end else begin
|
593 |
destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest)
|
594 |
end;
|
595 |
{$else}
|
596 |
destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest);
|
597 |
{$endif}
|
598 |
|
599 |
result := {$ifdef mswindows}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx^,destlen);
|
600 |
end;
|
601 |
|
602 |
|
603 |
function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
|
604 |
var
|
605 |
tempsrc:TInetSockAddrV;
|
606 |
tempsrclen:integer;
|
607 |
srcx : {$ifdef mswindows}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
|
608 |
biniptemp:tbinip;
|
609 |
begin
|
610 |
{$ifdef secondlistener}
|
611 |
if assigned(secondlistener) then if lastsessionfromsecond then begin
|
612 |
lastsessionfromsecond := false;
|
613 |
result := secondlistener.receivefrom(data,len,src,srclen);
|
614 |
exit;
|
615 |
end;
|
616 |
{$endif}
|
617 |
tempsrclen := sizeof(tempsrc);
|
618 |
result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
|
619 |
|
620 |
{$ifdef ipv6}
|
621 |
biniptemp := inaddrvtobinip(tempsrc);
|
622 |
if needconverttov4(biniptemp) then begin
|
623 |
converttov4(biniptemp);
|
624 |
tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
|
625 |
end;
|
626 |
{$endif}
|
627 |
|
628 |
move(tempsrc,src,srclen);
|
629 |
srclen := tempsrclen;
|
630 |
end;
|
631 |
|
632 |
procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
|
633 |
begin
|
634 |
connectionfailedhandler(wparam);
|
635 |
end;
|
636 |
|
637 |
procedure tlsocket.connectionfailedhandler(error:word);
|
638 |
begin
|
639 |
if trymoreips then begin
|
640 |
// writeln('failed with error ',error);
|
641 |
connecttimeout.enabled := false;
|
642 |
destroying := true;
|
643 |
state := wsconnected;
|
644 |
self.internalclose(0);
|
645 |
destroying := false;
|
646 |
realconnect;
|
647 |
end else begin
|
648 |
state := wsconnected;
|
649 |
if assigned(onsessionconnected) then onsessionconnected(self,error);
|
650 |
self.internalclose(0);
|
651 |
recvq.del(maxlongint);
|
652 |
end;
|
653 |
end;
|
654 |
|
655 |
procedure tlsocket.connectsuccesshandler;
|
656 |
begin
|
657 |
trymoreips := false;
|
658 |
connecttimeout.enabled := false;
|
659 |
if assigned(onsessionconnected) then onsessionconnected(self,0);
|
660 |
end;
|
661 |
|
662 |
|
663 |
procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
|
664 |
var
|
665 |
tempbuf:array[0..receivebufsize-1] of byte;
|
666 |
begin
|
667 |
// writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state));
|
668 |
if (state =wslistening) and readtrigger then begin
|
669 |
{ debugout('listening socket triggered on read');}
|
670 |
eventcore.rmasterclr(fdhandlein);
|
671 |
if assigned(onsessionAvailable) then onsessionAvailable(self,0);
|
672 |
end;
|
673 |
if dgram and readtrigger then begin
|
674 |
if assigned(ondataAvailable) then ondataAvailable(self,0);
|
675 |
{!!!test}
|
676 |
exit;
|
677 |
end;
|
678 |
if (state =wsconnecting) and writetrigger then begin
|
679 |
// code for dealing with the results of a non-blocking connect is
|
680 |
// rather complex
|
681 |
// if just write is triggered it means connect succeeded
|
682 |
// if both read and write are triggered it can mean 2 things
|
683 |
// 1: connect ok and data available
|
684 |
// 2: connect fail
|
685 |
// to find out which you must read from the socket and look for errors
|
686 |
// there if we read successfully we drop through into the code for firing
|
687 |
// the read event
|
688 |
if not readtrigger then begin
|
689 |
state := wsconnected;
|
690 |
connectsuccesshandler;
|
691 |
end else begin
|
692 |
numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
|
693 |
if numread <> -1 then begin
|
694 |
state := wsconnected;
|
695 |
connectsuccesshandler;
|
696 |
//connectread := true;
|
697 |
recvq.add(@tempbuf,numread);
|
698 |
end else begin
|
699 |
connectionfailedhandler({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
|
700 |
exit;
|
701 |
end;
|
702 |
// if things went well here we are now in the state wsconnected with data sitting in our receive buffer
|
703 |
// so we drop down into the processing for data available
|
704 |
end;
|
705 |
if fdhandlein >= 0 then begin
|
706 |
if state = wsconnected then begin
|
707 |
eventcore.rmasterset(fdhandlein,false);
|
708 |
end else begin
|
709 |
eventcore.rmasterclr(fdhandlein);
|
710 |
end;
|
711 |
end;
|
712 |
if fdhandleout >= 0 then begin
|
713 |
if sendq.size = 0 then begin
|
714 |
//don't clear the bit in fdswmaster if data is in the sendq
|
715 |
eventcore.wmasterclr(fdhandleout);
|
716 |
end;
|
717 |
end;
|
718 |
|
719 |
end;
|
720 |
inherited handlefdtrigger(readtrigger,writetrigger);
|
721 |
end;
|
722 |
|
723 |
constructor tlsocket.Create(AOwner: TComponent);
|
724 |
begin
|
725 |
inherited create(aowner);
|
726 |
closehandles := true;
|
727 |
trymoreips := true;
|
728 |
end;
|
729 |
|
730 |
|
731 |
|
732 |
function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
|
733 |
var
|
734 |
addrx : {$ifdef mswindows}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
|
735 |
begin
|
736 |
result := {$ifdef mswindows}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen);
|
737 |
end;
|
738 |
|
739 |
procedure tlsocket.getxaddrbin(var binip:tbinip);
|
740 |
var
|
741 |
addr:tinetsockaddrv;
|
742 |
i:integer;
|
743 |
begin
|
744 |
i := sizeof(addr);
|
745 |
fillchar(addr,sizeof(addr),0);
|
746 |
|
747 |
{$ifdef mswindows}
|
748 |
winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
|
749 |
{$else}
|
750 |
getsocketname(self.fdhandlein,addr,i);
|
751 |
{$endif}
|
752 |
binip := inaddrvtobinip(addr);
|
753 |
converttov4(binip);
|
754 |
end;
|
755 |
|
756 |
procedure tlsocket.getpeeraddrbin(var binip:tbinip);
|
757 |
var
|
758 |
addr:tinetsockaddrv;
|
759 |
i:integer;
|
760 |
begin
|
761 |
i := sizeof(addr);
|
762 |
fillchar(addr,sizeof(addr),0);
|
763 |
{$ifdef mswindows}
|
764 |
winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
|
765 |
{$else}
|
766 |
system_getpeername(self.fdhandlein,addr,i);
|
767 |
{$endif}
|
768 |
|
769 |
binip := inaddrvtobinip(addr);
|
770 |
converttov4(binip);
|
771 |
end;
|
772 |
|
773 |
function tlsocket.getXaddr:thostname;
|
774 |
var
|
775 |
biniptemp:tbinip;
|
776 |
begin
|
777 |
getxaddrbin(biniptemp);
|
778 |
result := ipbintostr(biniptemp);
|
779 |
if result = '' then result := 'error';
|
780 |
end;
|
781 |
|
782 |
function tlsocket.getpeeraddr:thostname;
|
783 |
var
|
784 |
biniptemp:tbinip;
|
785 |
begin
|
786 |
getpeeraddrbin(biniptemp);
|
787 |
result := ipbintostr(biniptemp);
|
788 |
if result = '' then result := 'error';
|
789 |
end;
|
790 |
|
791 |
function tlsocket.getXport:ansistring;
|
792 |
var
|
793 |
addr:tinetsockaddrv;
|
794 |
i:integer;
|
795 |
begin
|
796 |
i := sizeof(addr);
|
797 |
{$ifdef mswindows}
|
798 |
winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
|
799 |
|
800 |
{$else}
|
801 |
getsocketname(self.fdhandlein,addr,i);
|
802 |
|
803 |
{$endif}
|
804 |
result := inttostr(htons(addr.InAddr.port));
|
805 |
end;
|
806 |
|
807 |
function tlsocket.getpeerport:ansistring;
|
808 |
var
|
809 |
addr:tinetsockaddrv;
|
810 |
i:integer;
|
811 |
begin
|
812 |
i := sizeof(addr);
|
813 |
{$ifdef mswindows}
|
814 |
winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
|
815 |
|
816 |
{$else}
|
817 |
system_getpeername(self.fdhandlein,addr,i);
|
818 |
|
819 |
{$endif}
|
820 |
result := inttostr(htons(addr.InAddr.port));
|
821 |
end;
|
822 |
|
823 |
{$ifdef mswindows}
|
824 |
procedure tlsocket.myfdclose(fd : integer);
|
825 |
begin
|
826 |
closesocket(fd);
|
827 |
end;
|
828 |
function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
|
829 |
begin
|
830 |
result := winsock.send(fd,(@buf)^,size,0);
|
831 |
end;
|
832 |
function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
|
833 |
begin
|
834 |
result := winsock.recv(fd,buf,size,0);
|
835 |
end;
|
836 |
{$endif}
|
837 |
|
838 |
end.
|
839 |
|