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

Annotation of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Feb 12 22:26:21 2010 UTC (10 years ago) by plugwash
File size: 25410 byte(s)
add some missing ifdefs

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

Properties

Name Value
svn:eol-style CRLF
svn:executable

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