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

Annotation of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (hide annotations)
Fri Mar 28 03:18:52 2014 UTC (6 years ago) by beware
File size: 26043 byte(s)
fix spelling mistakes
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 beware 136 * (lcore) if closing the fd's in internalclose, set fds to -1 because closing an fd makes it invalid
26 plugwash 1
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 127 {$ifdef mswindows}
46 beware 17 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 beware 136 //mainthread : boolean ; //for debugging only
97 zipplet 79 addr:thostname;
98     port:ansistring;
99     localaddr:thostname;
100     localport:ansistring;
101     proto:ansistring;
102 beware 21 udp,dgram:boolean;
103 plugwash 1 listenqueue:integer;
104 beware 86
105     onconnecttryip:procedure(sender:tobject; const ip:tbinip) of object;
106    
107 beware 17 {$ifdef secondlistener}
108     secondlistener:tlsocket;
109     lastsessionfromsecond:boolean;
110     procedure secondaccepthandler(sender:tobject;error:word);
111     procedure internalclose(error:word);override;
112     {$endif}
113 plugwash 1 function getaddrsize:integer;
114     procedure connect; virtual;
115 beware 17 procedure realconnect;
116 plugwash 1 procedure bindsocket;
117     procedure listen;
118     function accept : longint;
119 beware 17 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 plugwash 1 procedure handlefdtrigger(readtrigger,writetrigger:boolean); override;
123     function send(data:pointer;len:integer):integer;override;
124 zipplet 79 procedure sendstr(const str : tbufferstring);override;
125 plugwash 1 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 zipplet 79 function getXaddr:thostname; virtual;
130     function getpeeraddr:thostname; virtual;
131     function getXport:ansistring; virtual;
132     function getpeerport:ansistring; virtual;
133 plugwash 1 constructor Create(AOwner: TComponent); override;
134 plugwash 32
135     //this one has to be kept public for now because lcorewsaasyncselect calls it
136     procedure connectionfailedhandler(error:word);
137 beware 94
138     {public in tlasio, and can't be private in both places, so should be public here.
139     fixes delphi warning --beware}
140 beware 127 {$ifdef mswindows}
141 beware 94 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 plugwash 32 private
147 plugwash 76 {$ifdef ipv6}
148     isv6socket : boolean; //identifies if the socket is v6, set by bindsocket
149     {$endif}
150 plugwash 32 procedure taskcallconnectionfailedhandler(wparam,lparam : longint);
151    
152     procedure connecttimeouthandler(sender:tobject);
153     procedure connectsuccesshandler;
154 plugwash 1 end;
155     tsocket=longint; // for compatibility with twsocket
156    
157     twsocket=tlsocket; {easy}
158    
159 beware 2
160 plugwash 1 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 beware 17 result := inaddrsize(inaddr);
171 plugwash 1 end;
172    
173 plugwash 60 //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 beware 127 {$ifndef mswindows}
178 plugwash 60 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 plugwash 1
200 beware 17 procedure tlsocket.realconnect;
201 plugwash 1 var
202 beware 21 a,b:integer;
203 beware 86 iptemp:tbinip;
204 beware 16 begin
205 beware 86 iptemp := biniplist_get(biniplist,currentip);
206 plugwash 32 //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);
207 beware 86 if assigned(onconnecttryip) then onconnecttryip(self,iptemp);
208     makeinaddrv(iptemp,port,inaddr);
209 beware 17 inc(currentip);
210     if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;
211 beware 21
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 plugwash 32 end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin
219 beware 21 b := IPPROTO_TCP;
220     a := SOCK_STREAM;
221     dgram := false;
222 plugwash 32 end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin
223 beware 21 b := strtointdef(proto,IPPROTO_ICMP);
224     a := SOCK_RAW;
225     dgram := true;
226 plugwash 32 end else begin
227     raise ESocketException.create('unrecognised protocol');
228 beware 21 end;
229    
230     a := Socket(inaddr.inaddr.family,a,b);
231 beware 17 //writeln(ord(inaddr.inaddr.family));
232 plugwash 1 if a = -1 then begin
233 plugwash 32 //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 beware 127 tltask.create(taskcallconnectionfailedhandler,self,{$ifdef mswindows}wsagetlasterror{$else}socketerror{$endif},0);
240 plugwash 32 exit;
241 plugwash 1 end;
242     try
243     dup(a);
244     bindsocket;
245 beware 21 if dgram then begin
246 beware 127 {$ifndef mswindows}
247 beware 17 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
248 zipplet 25 {$else}
249     SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
250 beware 17 {$endif}
251 plugwash 1 state := wsconnected;
252     if assigned(onsessionconnected) then onsessionconnected(self,0);
253 beware 17
254     eventcore.rmasterset(fdhandlein,false);
255     eventcore.wmasterclr(fdhandleout);
256 plugwash 1 end else begin
257     state :=wsconnecting;
258 beware 127 {$ifdef mswindows}
259 beware 17 //writeln(inaddr.inaddr.port);
260     winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize);
261     {$else}
262 plugwash 60 system_Connect(fdhandlein,inADDR,getaddrsize);
263 beware 17 {$endif}
264     eventcore.rmasterset(fdhandlein,false);
265     eventcore.wmasterset(fdhandleout);
266     if trymoreips then connecttimeout.enabled := true;
267 plugwash 1 end;
268     //sendq := '';
269     except
270     on e: exception do begin
271     fdcleanup;
272     raise; //reraise the exception
273     end;
274     end;
275 beware 17
276 plugwash 1 end;
277    
278 beware 17 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 plugwash 60
288    
289    
290 beware 17 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 beware 87 connecttimeout.interval := 5000;
304 beware 17 connecttimeout.enabled := false;
305     end;
306     realconnect;
307     end;
308    
309 zipplet 79 procedure tlsocket.sendstr(const str : tbufferstring);
310 plugwash 1 begin
311 beware 21 if dgram then begin
312 plugwash 1 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 beware 21 if dgram then begin
321 beware 17 // 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 plugwash 1 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 beware 21 if dgram then begin
335 beware 17 {$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 plugwash 1 end else begin
343     result := inherited receive(buf,bufsize);
344     end;
345     end;
346    
347     procedure tlsocket.bindsocket;
348     var
349     inAddrtemp:TInetSockAddrV;
350 beware 127 inAddrtempx:{$ifdef mswindows}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp;
351 plugwash 1 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 beware 17 inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp);
363 plugwash 76 {$ifdef ipv6}
364     isv6socket := (inaddrtemp.inaddr.family = AF_INET6);
365     {$endif}
366 beware 127 If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef mswindows}0{$else}true{$endif} Then begin
367 plugwash 1 state := wsclosed;
368 beware 127 lasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif};
369 beware 20 raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
370 plugwash 1 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 beware 127 {$ifndef mswindows}
384 plugwash 73 yes,no:longint;
385 beware 94 {$endif}
386 plugwash 1 socktype:integer;
387     biniptemp:tbinip;
388 zipplet 79 origaddr:thostname;
389 plugwash 1 begin
390     if state <> wsclosed then close;
391     udp := uppercase(proto) = 'UDP';
392 beware 24 if udp then begin
393     socktype := SOCK_DGRAM;
394     dgram := true;
395     end else socktype := SOCK_STREAM;
396 plugwash 1 origaddr := addr;
397    
398     if addr = '' then begin
399     {$ifdef ipv6}
400 plugwash 75 //writeln('ipv6 is defined');
401 plugwash 1 if not v4listendefault then begin
402 plugwash 75 //writeln('setting addr to ::');
403 plugwash 1 addr := '::';
404     end else
405     {$endif}
406     addr := '0.0.0.0';
407     end;
408 beware 17 if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10);
409 plugwash 1 addr := ipbintostr(biniptemp);
410 plugwash 75 //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 plugwash 1 fdhandlein := socket(biniptemp.family,socktype,0);
418     {$ifdef ipv6}
419     if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin
420 zipplet 79 {writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead');}
421 plugwash 1 addr := '0.0.0.0';
422 beware 103 biniptemp := ipstrtobinf(addr);
423 plugwash 75 fdhandlein := socket(PF_INET,socktype,0);
424 plugwash 1 end;
425     {$endif}
426 beware 17
427 beware 127 if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef mswindows}+' error='+inttostr(wsagetlasterror){$endif});
428 beware 17 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 plugwash 1 state := wsclosed; // then set this back as it was an undesired side effect of dup
431    
432     try
433 beware 127 {$ifndef mswindows}
434 beware 94 yes := $01010101; {Copied this from existing code. Value is empiric,
435 plugwash 1 but works. (yes=true<>0) }
436 beware 94 no := 0;
437    
438 beware 17 if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin
439 plugwash 75 raise ESocketException.create('unable to set SO_REUSEADDR socket option');
440 beware 17 end;
441 plugwash 75 //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 plugwash 73 end;
452 beware 115 {$else}
453     SetSockOpt(fdhandlein, SOL_SOCKET, SO_REUSEADDR, 'TRUE', Length('TRUE'));
454    
455 beware 17 {$endif}
456 plugwash 1 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 beware 127 If {$ifdef mswindows}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef mswindows}0{$else}true{$endif} Then raise
464 zipplet 25 esocketexception.create('unable to listen');
465 plugwash 1 state := wsListening;
466     end else begin
467 beware 127 {$ifndef mswindows}
468 beware 17 SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
469 zipplet 25 {$else}
470     SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE'));
471 beware 17 {$endif}
472 plugwash 1 state := wsconnected;
473     end;
474 beware 17
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 plugwash 1 finally
496     if state = wsclosed then begin
497     if fdhandlein >= 0 then begin
498     {one *can* get here without fd -beware}
499 beware 17 eventcore.rmasterclr(fdhandlein);
500 beware 136 myfdclose(fdhandlein); // we musnt leak file descriptors
501 beware 17 eventcore.setfdreverse(fdhandlein,nil);
502 plugwash 1 fdhandlein := -1;
503     end;
504     end else begin
505 beware 17 eventcore.rmasterset(fdhandlein,not udp);
506 plugwash 1 end;
507 beware 17 if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);
508 plugwash 1 end;
509 beware 17 //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein);
510 plugwash 1 end;
511    
512 beware 17 {$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 plugwash 1 function tlsocket.accept : longint;
534     var
535 beware 136 FromAddrSize : LongInt; // i don't really know what to do with these at this
536 beware 17 FromAddr : TInetSockAddrV; // at this point time will tell :)
537     a:integer;
538 plugwash 1 begin
539 beware 17 {$ifdef secondlistener}
540     if (lastsessionfromsecond) then begin
541     lastsessionfromsecond := false;
542     result := secondlistener.accept;
543     exit;
544     end;
545     {$endif}
546    
547 plugwash 1 FromAddrSize := Sizeof(FromAddr);
548 beware 127 {$ifdef mswindows}
549 beware 17 result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize);
550     {$else}
551 plugwash 60 result := system_accept(fdhandlein,fromaddr,fromaddrsize);
552 beware 17 {$endif}
553     //now we have accepted one request start monitoring for more again
554     eventcore.rmasterset(fdhandlein,true);
555    
556     if result = -1 then begin
557 beware 127 raise esocketexception.create('error '+inttostr({$ifdef mswindows}getlasterror{$else}socketerror{$endif})+' while accepting');
558 beware 17 end;
559 beware 136 if result > absolutemaxs then begin
560 beware 17 myfdclose(result);
561     a := result;
562 beware 94 { result := -1;}
563 beware 136 raise esocketexception.create('file descriptor out of range: '+inttostr(a));
564 plugwash 1 end;
565     end;
566    
567 plugwash 60
568 beware 17 function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer;
569     var
570 plugwash 75 {$ifdef ipv6}
571     realdest : tinetsockaddrv;
572     biniptemp : tbinip;
573     {$endif}
574 beware 127 destx : {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif};
575 plugwash 75
576 plugwash 1 begin
577 beware 17 {$ifdef secondlistener}
578 plugwash 75 if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin
579     result := secondlistener.sendto(dest,destlen,data,len);
580     exit;
581     end;
582 beware 17 {$endif}
583 plugwash 75 {$ifdef ipv6}
584     if isv6socket then begin
585     biniptemp := inaddrvtobinip(dest);
586     converttov6(biniptemp);
587     destlen := makeinaddrv(biniptemp,inttostr(ntohs(dest.InAddr.port)),realdest);
588 beware 127 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@realdest)
589 plugwash 75 end else begin
590 beware 127 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest)
591 plugwash 75 end;
592     {$else}
593 beware 127 destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest);
594 plugwash 75 {$endif}
595    
596 beware 127 result := {$ifdef mswindows}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx^,destlen);
597 plugwash 1 end;
598    
599 plugwash 60
600 beware 17 function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
601     var
602 beware 20 tempsrc:TInetSockAddrV;
603     tempsrclen:integer;
604 beware 127 srcx : {$ifdef mswindows}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
605 beware 20 biniptemp:tbinip;
606 plugwash 1 begin
607 beware 17 {$ifdef secondlistener}
608     if assigned(secondlistener) then if lastsessionfromsecond then begin
609     lastsessionfromsecond := false;
610     result := secondlistener.receivefrom(data,len,src,srclen);
611     exit;
612     end;
613     {$endif}
614 beware 20 tempsrclen := sizeof(tempsrc);
615 plugwash 60 result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
616 beware 20
617     {$ifdef ipv6}
618     biniptemp := inaddrvtobinip(tempsrc);
619     if needconverttov4(biniptemp) then begin
620     converttov4(biniptemp);
621     tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
622     end;
623     {$endif}
624    
625     move(tempsrc,src,srclen);
626     srclen := tempsrclen;
627 plugwash 1 end;
628    
629 plugwash 32 procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
630     begin
631     connectionfailedhandler(wparam);
632     end;
633    
634 beware 17 procedure tlsocket.connectionfailedhandler(error:word);
635     begin
636     if trymoreips then begin
637     // writeln('failed with error ',error);
638     connecttimeout.enabled := false;
639     destroying := true;
640     state := wsconnected;
641     self.internalclose(0);
642     destroying := false;
643     realconnect;
644     end else begin
645     state := wsconnected;
646     if assigned(onsessionconnected) then onsessionconnected(self,error);
647     self.internalclose(0);
648     recvq.del(maxlongint);
649     end;
650     end;
651    
652     procedure tlsocket.connectsuccesshandler;
653     begin
654     trymoreips := false;
655     connecttimeout.enabled := false;
656     if assigned(onsessionconnected) then onsessionconnected(self,0);
657     end;
658    
659    
660 plugwash 1 procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean);
661     var
662     tempbuf:array[0..receivebufsize-1] of byte;
663     begin
664 beware 17 // writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state));
665 plugwash 1 if (state =wslistening) and readtrigger then begin
666     { debugout('listening socket triggered on read');}
667 beware 17 eventcore.rmasterclr(fdhandlein);
668 plugwash 1 if assigned(onsessionAvailable) then onsessionAvailable(self,0);
669     end;
670 beware 21 if dgram and readtrigger then begin
671 plugwash 1 if assigned(ondataAvailable) then ondataAvailable(self,0);
672     {!!!test}
673     exit;
674     end;
675     if (state =wsconnecting) and writetrigger then begin
676 beware 136 // code for dealing with the results of a non-blocking connect is
677 plugwash 1 // rather complex
678 beware 136 // if just write is triggered it means connect succeeded
679 beware 17 // if both read and write are triggered it can mean 2 things
680 beware 136 // 1: connect ok and data available
681 plugwash 1 // 2: connect fail
682     // to find out which you must read from the socket and look for errors
683 beware 136 // there if we read successfully we drop through into the code for firing
684 plugwash 1 // the read event
685     if not readtrigger then begin
686     state := wsconnected;
687 beware 17 connectsuccesshandler;
688 plugwash 1 end else begin
689 beware 17 numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
690 plugwash 1 if numread <> -1 then begin
691     state := wsconnected;
692 beware 17 connectsuccesshandler;
693 plugwash 1 //connectread := true;
694     recvq.add(@tempbuf,numread);
695     end else begin
696 beware 127 connectionfailedhandler({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
697 beware 17 exit;
698 plugwash 1 end;
699     // if things went well here we are now in the state wsconnected with data sitting in our receive buffer
700 beware 136 // so we drop down into the processing for data available
701 plugwash 1 end;
702     if fdhandlein >= 0 then begin
703     if state = wsconnected then begin
704 beware 17 eventcore.rmasterset(fdhandlein,false);
705 plugwash 1 end else begin
706 beware 17 eventcore.rmasterclr(fdhandlein);
707 plugwash 1 end;
708     end;
709     if fdhandleout >= 0 then begin
710     if sendq.size = 0 then begin
711     //don't clear the bit in fdswmaster if data is in the sendq
712 beware 17 eventcore.wmasterclr(fdhandleout);
713 plugwash 1 end;
714     end;
715    
716     end;
717     inherited handlefdtrigger(readtrigger,writetrigger);
718     end;
719    
720     constructor tlsocket.Create(AOwner: TComponent);
721     begin
722     inherited create(aowner);
723     closehandles := true;
724 beware 17 trymoreips := true;
725 plugwash 1 end;
726    
727    
728 plugwash 60
729 plugwash 1 function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer;
730 beware 17 var
731 beware 127 addrx : {$ifdef mswindows}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr;
732 plugwash 1 begin
733 beware 127 result := {$ifdef mswindows}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen);
734 plugwash 1 end;
735    
736     procedure tlsocket.getxaddrbin(var binip:tbinip);
737     var
738     addr:tinetsockaddrv;
739     i:integer;
740     begin
741     i := sizeof(addr);
742     fillchar(addr,sizeof(addr),0);
743    
744 beware 127 {$ifdef mswindows}
745 beware 17 winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
746     {$else}
747 plugwash 73 getsocketname(self.fdhandlein,addr,i);
748 beware 17 {$endif}
749 beware 20 binip := inaddrvtobinip(addr);
750 plugwash 1 converttov4(binip);
751     end;
752    
753     procedure tlsocket.getpeeraddrbin(var binip:tbinip);
754     var
755     addr:tinetsockaddrv;
756     i:integer;
757     begin
758     i := sizeof(addr);
759     fillchar(addr,sizeof(addr),0);
760 beware 127 {$ifdef mswindows}
761 beware 17 winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i);
762     {$else}
763 plugwash 60 system_getpeername(self.fdhandlein,addr,i);
764 beware 17 {$endif}
765 plugwash 1
766 beware 20 binip := inaddrvtobinip(addr);
767 plugwash 1 converttov4(binip);
768     end;
769    
770 zipplet 79 function tlsocket.getXaddr:thostname;
771 plugwash 1 var
772     biniptemp:tbinip;
773     begin
774     getxaddrbin(biniptemp);
775     result := ipbintostr(biniptemp);
776     if result = '' then result := 'error';
777     end;
778    
779 zipplet 79 function tlsocket.getpeeraddr:thostname;
780 plugwash 1 var
781     biniptemp:tbinip;
782     begin
783     getpeeraddrbin(biniptemp);
784     result := ipbintostr(biniptemp);
785     if result = '' then result := 'error';
786     end;
787    
788 zipplet 79 function tlsocket.getXport:ansistring;
789 plugwash 1 var
790 beware 17 addr:tinetsockaddrv;
791 plugwash 1 i:integer;
792     begin
793     i := sizeof(addr);
794 beware 127 {$ifdef mswindows}
795 beware 17 winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
796    
797     {$else}
798 plugwash 73 getsocketname(self.fdhandlein,addr,i);
799 beware 17
800     {$endif}
801     result := inttostr(htons(addr.InAddr.port));
802 plugwash 1 end;
803    
804 zipplet 79 function tlsocket.getpeerport:ansistring;
805 plugwash 1 var
806 beware 17 addr:tinetsockaddrv;
807 plugwash 1 i:integer;
808     begin
809     i := sizeof(addr);
810 beware 127 {$ifdef mswindows}
811 beware 17 winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i);
812    
813     {$else}
814 plugwash 60 system_getpeername(self.fdhandlein,addr,i);
815 beware 17
816     {$endif}
817     result := inttostr(htons(addr.InAddr.port));
818 plugwash 1 end;
819    
820 beware 127 {$ifdef mswindows}
821 beware 17 procedure tlsocket.myfdclose(fd : integer);
822     begin
823     closesocket(fd);
824     end;
825     function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
826     begin
827     result := winsock.send(fd,(@buf)^,size,0);
828     end;
829     function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
830     begin
831     result := winsock.recv(fd,buf,size,0);
832     end;
833     {$endif}
834 beware 18
835 plugwash 1 end.
836 beware 17

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.22