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

Annotation of /trunk/lsocket.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 61 - (hide annotations)
Thu Feb 4 22:47:07 2010 UTC (10 years ago) by plugwash
File size: 23638 byte(s)
set line ending property on files to hopefully avoid line ending problems in future

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