/[lcore]/trunk/lsocket.pas
ViewVC logotype

Contents of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 163 - (show annotations)
Tue Oct 12 21:32:15 2021 UTC (6 weeks, 3 days ago) by beware
File size: 26414 byte(s)
windows: fix that an immediate connect error is not seen and the socket is stuck connecting forever
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 //beware: atleast on windows, wsaasyncselect set interest in events before connecting, or a connect error isn't seen if it happens immediately during connect
260 eventcore.rmasterset(fdhandlein,false);
261 eventcore.wmasterset(fdhandleout);
262 //writeln(inaddr.inaddr.port);
263 winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
264 {$else}
265 system_Connect(fdhandlein,inADDR,getaddrsize);
266 eventcore.rmasterset(fdhandlein,false);
267 eventcore.wmasterset(fdhandleout);
268 {$endif}
269 if trymoreips then connecttimeout.enabled := true;
270 end;
271 //sendq := '';
272 except
273 on e: exception do begin
274 fdcleanup;
275 raise; //reraise the exception
276 end;
277 end;
278
279 end;
280
281 procedure tlsocket.connecttimeouthandler(sender:tobject);
282 begin
283 connecttimeout.enabled := false;
284 destroying := true; //hack to not cause handler to trigger
285 internalclose(0);
286 destroying := false;
287 realconnect;
288 end;
289
290
291
292
293 procedure tlsocket.connect;
294 begin
295 if state <> wsclosed then close;
296 //prevtime := 0;
297 if isbiniplist(addr) then biniplist := addr else biniplist := forwardlookuplist(addr,0);
298 if biniplist_getcount(biniplist) = 0 then raise exception.create('unable to resolve '+addr);
299
300 //makeinaddrv(addr,port,inaddr);
301
302 currentip := 0;
303 if not assigned(connecttimeout) then begin
304 connecttimeout := tltimer.create(self);
305 connecttimeout.ontimer := connecttimeouthandler;
306 connecttimeout.interval := 5000;
307 connecttimeout.enabled := false;
308 end;
309 realconnect;
310 end;
311
312 procedure tlsocket.sendstr(const str : tbufferstring);
313 begin
314 if dgram then begin
315 send(@str[1],length(str))
316 end else begin
317 inherited sendstr(str);
318 end;
319 end;
320
321 function tlsocket.send(data:pointer;len:integer):integer;
322 begin
323 if dgram then begin
324 // writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes');
325 result := sendto(inaddr,getaddrsize,data,len);
326
327 // writeln('send result ',result);
328 // writeln('errno',errno);
329 end else begin
330 result := inherited send(data,len);
331 end;
332 end;
333
334
335 function tlsocket.receive(Buf:Pointer;BufSize:integer):integer;
336 begin
337 if dgram then begin
338 {$ifdef secondlistener}
339 if lastsessionfromsecond then begin
340 result := secondlistener.receive(buf,bufsize);
341 lastsessionfromsecond := false;
342 end else
343 {$endif}
344 result := myfdread(self.fdhandlein,buf^,bufsize);
345 end else begin
346 result := inherited receive(buf,bufsize);
347 end;
348 end;
349
350 procedure tlsocket.bindsocket;
351 var
352 inAddrtemp:TInetSockAddrV;
353 inAddrtempx:{$ifdef mswindows}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
354 inaddrtempsize:integer;
355 begin
356 try
357 if (localaddr <> '') or (localport <> '') then begin
358 if localaddr = '' then begin
359 {$ifdef ipv6}
360 if inaddr.inaddr.family = AF_INET6 then localaddr := '::' else
361 {$endif}
362 localaddr := '0.0.0.0';
363 end;
364 //gethostbyname(localaddr,host);
365 inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp);
366 {$ifdef ipv6}
367 isv6socket := (inaddrtemp.inaddr.family = AF_INET6);
368 {$endif}
369 If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef mswindows}0{$else}true{$endif} Then begin
370 state := wsclosed;
371 lasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif};
372 raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
373 end;
374 state := wsbound;
375 end;
376 except
377 on e: exception do begin
378 fdcleanup;
379 raise; //reraise the exception
380 end;
381 end;
382 end;
383
384 procedure tlsocket.listen;
385 var
386 {$ifndef mswindows}
387 yes,no:longint;
388 {$endif}
389 socktype:integer;
390 biniptemp:tbinip;
391 origaddr:thostname;
392 begin
393 if state <> wsclosed then close;
394 udp := uppercase(proto) = 'UDP';
395 if udp then begin
396 socktype := SOCK_DGRAM;
397 dgram := true;
398 end else socktype := SOCK_STREAM;
399 origaddr := addr;
400
401 if addr = '' then begin
402 {$ifdef ipv6}
403 //writeln('ipv6 is defined');
404 if not v4listendefault then begin
405 //writeln('setting addr to ::');
406 addr := '::';
407 end else
408 {$endif}
409 addr := '0.0.0.0';
410 end;
411 if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10);
412 addr := ipbintostr(biniptemp);
413 //writeln('after ipbintostr call addr =',addr);
414 //writeln('biniptemp.family =',biniptemp.family);
415 //writeln('AF_INET6=',AF_INET6);
416 //writeln('PF_INET6=',PF_INET6);
417 //writeln('AF_INET=',AF_INET);
418 //writeln('PF_INET=',PF_INET);
419
420 fdhandlein := socket(biniptemp.family,socktype,0);
421 {$ifdef ipv6}
422 if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
423 {writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead');}
424 addr := '0.0.0.0';
425 biniptemp := ipstrtobinf(addr);
426 fdhandlein := socket(PF_INET,socktype,0);
427 end;
428 {$endif}
429
430 if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef mswindows}+' error='+inttostr(wsagetlasterror){$endif});
431 dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things
432 //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup
433 state := wsclosed; // then set this back as it was an undesired side effect of dup
434
435 try
436 {$ifndef mswindows}
437 yes := $01010101; {Copied this from existing code. Value is empiric,
438 but works. (yes=true<>0) }
439 no := 0;
440
441 if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
442 raise ESocketException.create('unable to set SO_REUSEADDR socket option');
443 end;
444 //writeln('addr=',addr);
445 //writeln('setting IPV6_V6ONLY option to 0');
446 //allow v4 connections on v6 sockets
447 if biniptemp.family = af_inet6 then begin
448 if SetSocketOptions(fdhandlein, IPPROTO_IPV6,IPV6_V6ONLY,no,sizeof(no))=-1 then begin
449 writeln(IPPROTO_IPV6);
450 writeln(IPV6_V6ONLY);
451 raise ESocketException.create('unable to set IPV6_V6ONLY socket option error='+inttostr(socketerror));
452
453 end;
454 end;
455 {$else}
456 SetSockOpt(fdhandlein, SOL_SOCKET, SO_REUSEADDR, 'TRUE', Length('TRUE'));
457
458 {$endif}
459 localaddr := addr;
460 localport := port;
461 bindsocket;
462
463 if not udp then begin
464 {!!! allow custom queue length? default 5}
465 if listenqueue = 0 then listenqueue := 5;
466 If {$ifdef mswindows}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef mswindows}0{$else}true{$endif} Then raise
467 esocketexception.create('unable to listen');
468 state := wsListening;
469 end else begin
470 {$ifndef mswindows}
471 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
472 {$else}
473 SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
474 {$endif}
475 state := wsconnected;
476 end;
477
478 {$ifdef secondlistener}
479 //listening on ::. try to listen on 0.0.0.0 as well for platforms which don't already do that
480 if addr = '::' then begin
481 secondlistener := tlsocket.create(nil);
482 secondlistener.proto := proto;
483 secondlistener.addr := '0.0.0.0';
484 secondlistener.port := port;
485 if udp then begin
486 secondlistener.ondataavailable := secondaccepthandler;
487 end else begin
488 secondlistener.onsessionAvailable := secondaccepthandler;
489 end;
490 try
491 secondlistener.listen;
492 except
493 secondlistener.destroy;
494 secondlistener := nil;
495 end;
496 end;
497 {$endif}
498 finally
499 if state = wsclosed then begin
500 if fdhandlein >= 0 then begin
501 {one *can* get here without fd -beware}
502 eventcore.rmasterclr(fdhandlein);
503 myfdclose(fdhandlein); // we musnt leak file descriptors
504 eventcore.setfdreverse(fdhandlein,nil);
505 fdhandlein := -1;
506 end;
507 end else begin
508 eventcore.rmasterset(fdhandlein,not udp);
509 end;
510 if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
511 end;
512 //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein);
513 end;
514
515 {$ifdef secondlistener}
516 procedure tlsocket.internalclose(error:word);
517 begin
518 if assigned(secondlistener) then begin
519 secondlistener.destroy;
520 secondlistener := nil;
521 end;
522 inherited internalclose(error);
523 end;
524
525 procedure tlsocket.secondaccepthandler;
526 begin
527 lastsessionfromsecond := true;
528 if udp then begin
529 ondataavailable(self,error);
530 end else begin
531 if assigned(onsessionavailable) then onsessionavailable(self,error);
532 end;
533 end;
534 {$endif}
535
536 function tlsocket.accept : longint;
537 var
538 FromAddrSize : LongInt; // i don't really know what to do with these at this
539 FromAddr : TInetSockAddrV; // at this point time will tell :)
540 a,acceptlasterror:integer;
541 begin
542 {$ifdef secondlistener}
543 if (lastsessionfromsecond) then begin
544 lastsessionfromsecond := false;
545 result := secondlistener.accept;
546 exit;
547 end;
548 {$endif}
549
550 FromAddrSize := Sizeof(FromAddr);
551 {$ifdef mswindows}
552 result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
553 {$else}
554 result := system_accept(fdhandlein,fromaddr,fromaddrsize);
555 {$endif}
556
557 if (result = -1) then acceptlasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif} else acceptlasterror := 0;
558
559 //now we have accepted one request start monitoring for more again
560 eventcore.rmasterset(fdhandlein,true);
561
562 if result = -1 then begin
563 raise esocketexception.create('error '+inttostr(acceptlasterror)+' while accepting');
564 end;
565 if result > absolutemaxs then begin
566 myfdclose(result);
567 a := result;
568 { result := -1;}
569 raise esocketexception.create('file descriptor out of range: '+inttostr(a));
570 end;
571 end;
572
573
574 function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer;
575 var
576 {$ifdef ipv6}
577 realdest : tinetsockaddrv;
578 biniptemp : tbinip;
579 {$endif}
580 destx : {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif};
581
582 begin
583 {$ifdef secondlistener}
584 if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin
585 result := secondlistener.sendto(dest,destlen,data,len);
586 exit;
587 end;
588 {$endif}
589 {$ifdef ipv6}
590 if isv6socket then begin
591 biniptemp := inaddrvtobinip(dest);
592 converttov6(biniptemp);
593 destlen := makeinaddrv(biniptemp,inttostr(ntohs(dest.InAddr.port)),realdest);
594 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@realdest)
595 end else begin
596 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest)
597 end;
598 {$else}
599 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest);
600 {$endif}
601
602 result := {$ifdef mswindows}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx^,destlen);
603 end;
604
605
606 function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
607 var
608 tempsrc:TInetSockAddrV;
609 tempsrclen:integer;
610 srcx : {$ifdef mswindows}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
611 biniptemp:tbinip;
612 begin
613 {$ifdef secondlistener}
614 if assigned(secondlistener) then if lastsessionfromsecond then begin
615 lastsessionfromsecond := false;
616 result := secondlistener.receivefrom(data,len,src,srclen);
617 exit;
618 end;
619 {$endif}
620 tempsrclen := sizeof(tempsrc);
621 result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
622
623 {$ifdef ipv6}
624 biniptemp := inaddrvtobinip(tempsrc);
625 if needconverttov4(biniptemp) then begin
626 converttov4(biniptemp);
627 tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
628 end;
629 {$endif}
630
631 move(tempsrc,src,srclen);
632 srclen := tempsrclen;
633 end;
634
635 procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
636 begin
637 connectionfailedhandler(wparam);
638 end;
639
640 procedure tlsocket.connectionfailedhandler(error:word);
641 begin
642 if trymoreips then begin
643 // writeln('failed with error ',error);
644 connecttimeout.enabled := false;
645 destroying := true;
646 state := wsconnected;
647 self.internalclose(0);
648 destroying := false;
649 realconnect;
650 end else begin
651 state := wsconnected;
652 if assigned(onsessionconnected) then onsessionconnected(self,error);
653 self.internalclose(0);
654 recvq.del(maxlongint);
655 end;
656 end;
657
658 procedure tlsocket.connectsuccesshandler;
659 begin
660 trymoreips := false;
661 connecttimeout.enabled := false;
662 if assigned(onsessionconnected) then onsessionconnected(self,0);
663 end;
664
665
666 procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
667 var
668 tempbuf:array[0..receivebufsize-1] of byte;
669 begin
670 // writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state));
671 if (state =wslistening) and readtrigger then begin
672 { debugout('listening socket triggered on read');}
673 eventcore.rmasterclr(fdhandlein);
674 if assigned(onsessionAvailable) then onsessionAvailable(self,0);
675 end;
676 if dgram and readtrigger then begin
677 if assigned(ondataAvailable) then ondataAvailable(self,0);
678 {!!!test}
679 exit;
680 end;
681 if (state =wsconnecting) and writetrigger then begin
682 // code for dealing with the results of a non-blocking connect is
683 // rather complex
684 // if just write is triggered it means connect succeeded
685 // if both read and write are triggered it can mean 2 things
686 // 1: connect ok and data available
687 // 2: connect fail
688 // to find out which you must read from the socket and look for errors
689 // there if we read successfully we drop through into the code for firing
690 // the read event
691 if not readtrigger then begin
692 state := wsconnected;
693 connectsuccesshandler;
694 end else begin
695 numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
696 if numread <> -1 then begin
697 state := wsconnected;
698 connectsuccesshandler;
699 //connectread := true;
700 recvq.add(@tempbuf,numread);
701 end else begin
702 connectionfailedhandler({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
703 exit;
704 end;
705 // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
706 // so we drop down into the processing for data available
707 end;
708 if fdhandlein >= 0 then begin
709 if state = wsconnected then begin
710 eventcore.rmasterset(fdhandlein,false);
711 end else begin
712 eventcore.rmasterclr(fdhandlein);
713 end;
714 end;
715 if fdhandleout >= 0 then begin
716 if sendq.size = 0 then begin
717 //don't clear the bit in fdswmaster if data is in the sendq
718 eventcore.wmasterclr(fdhandleout);
719 end;
720 end;
721
722 end;
723 inherited handlefdtrigger(readtrigger,writetrigger);
724 end;
725
726 constructor tlsocket.Create(AOwner: TComponent);
727 begin
728 inherited create(aowner);
729 closehandles := true;
730 trymoreips := true;
731 end;
732
733
734
735 function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
736 var
737 addrx : {$ifdef mswindows}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
738 begin
739 result := {$ifdef mswindows}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen);
740 end;
741
742 procedure tlsocket.getxaddrbin(var binip:tbinip);
743 var
744 addr:tinetsockaddrv;
745 i:integer;
746 begin
747 i := sizeof(addr);
748 fillchar(addr,sizeof(addr),0);
749
750 {$ifdef mswindows}
751 winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
752 {$else}
753 getsocketname(self.fdhandlein,addr,i);
754 {$endif}
755 binip := inaddrvtobinip(addr);
756 converttov4(binip);
757 end;
758
759 procedure tlsocket.getpeeraddrbin(var binip:tbinip);
760 var
761 addr:tinetsockaddrv;
762 i:integer;
763 begin
764 i := sizeof(addr);
765 fillchar(addr,sizeof(addr),0);
766 {$ifdef mswindows}
767 winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
768 {$else}
769 system_getpeername(self.fdhandlein,addr,i);
770 {$endif}
771
772 binip := inaddrvtobinip(addr);
773 converttov4(binip);
774 end;
775
776 function tlsocket.getXaddr:thostname;
777 var
778 biniptemp:tbinip;
779 begin
780 getxaddrbin(biniptemp);
781 result := ipbintostr(biniptemp);
782 if result = '' then result := 'error';
783 end;
784
785 function tlsocket.getpeeraddr:thostname;
786 var
787 biniptemp:tbinip;
788 begin
789 getpeeraddrbin(biniptemp);
790 result := ipbintostr(biniptemp);
791 if result = '' then result := 'error';
792 end;
793
794 function tlsocket.getXport:ansistring;
795 var
796 addr:tinetsockaddrv;
797 i:integer;
798 begin
799 i := sizeof(addr);
800 {$ifdef mswindows}
801 winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
802
803 {$else}
804 getsocketname(self.fdhandlein,addr,i);
805
806 {$endif}
807 result := inttostr(htons(addr.InAddr.port));
808 end;
809
810 function tlsocket.getpeerport:ansistring;
811 var
812 addr:tinetsockaddrv;
813 i:integer;
814 begin
815 i := sizeof(addr);
816 {$ifdef mswindows}
817 winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
818
819 {$else}
820 system_getpeername(self.fdhandlein,addr,i);
821
822 {$endif}
823 result := inttostr(htons(addr.InAddr.port));
824 end;
825
826 {$ifdef mswindows}
827 procedure tlsocket.myfdclose(fd : integer);
828 begin
829 closesocket(fd);
830 end;
831 function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
832 begin
833 result := winsock.send(fd,(@buf)^,size,0);
834 end;
835 function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
836 begin
837 result := winsock.recv(fd,buf,size,0);
838 end;
839 {$endif}
840
841 end.
842

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.26