X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/b26fd4db949d4b212a33127c2b1356b9aa543772..0ac6b47e810e6efaebcdbf3075b633e9b4109341:/lsocket.pas diff --git a/lsocket.pas b/lsocket.pas index 1dff390..ddee93e 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -107,9 +107,6 @@ type procedure secondaccepthandler(sender:tobject;error:word); procedure internalclose(error:word);override; {$endif} - procedure connectionfailedhandler(error:word); - procedure connecttimeouthandler(sender:tobject); - procedure connectsuccesshandler; function getaddrsize:integer; procedure connect; virtual; procedure realconnect; @@ -131,6 +128,14 @@ type function getXport:string; virtual; function getpeerport:string; virtual; constructor Create(AOwner: TComponent); override; + + //this one has to be kept public for now because lcorewsaasyncselect calls it + procedure connectionfailedhandler(error:word); + private + procedure taskcallconnectionfailedhandler(wparam,lparam : longint); + + procedure connecttimeouthandler(sender:tobject); + procedure connectsuccesshandler; {$ifdef win32} procedure myfdclose(fd : integer); override; function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; @@ -160,7 +165,7 @@ procedure tlsocket.realconnect; var a,b:integer; begin -// writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port); + //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port); makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr); inc(currentip); if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false; @@ -171,21 +176,29 @@ begin a := SOCK_DGRAM; udp := true; dgram := true; - end else if (uppercase(proto) = 'TCP') then begin + end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin b := IPPROTO_TCP; a := SOCK_STREAM; dgram := false; - end else begin + end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin b := strtointdef(proto,IPPROTO_ICMP); a := SOCK_RAW; dgram := true; + end else begin + raise ESocketException.create('unrecognised protocol'); end; a := Socket(inaddr.inaddr.family,a,b); //writeln(ord(inaddr.inaddr.family)); if a = -1 then begin - lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif}; - raise esocketexception.create('unable to create socket'); + //unable to create socket, fire an error event (better to use an error event + //to avoid poor interaction with multilistener stuff. + //a socket value of -2 is a special value to say there is no socket but + //we want internalclose to act as if there was + fdhandlein := -2; + fdhandleout := -2; + tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0); + exit; end; try dup(a); @@ -247,7 +260,6 @@ begin currentip := 0; if not assigned(connecttimeout) then begin connecttimeout := tltimer.create(self); - connecttimeout.Tag := integer(self); connecttimeout.ontimer := connecttimeouthandler; connecttimeout.interval := 2500; connecttimeout.enabled := false; @@ -359,7 +371,7 @@ begin end; {$endif} - if fdhandlein = -1 then raise ESocketException.create('unable to create socket'); + if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif}); dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup state := wsclosed; // then set this back as it was an undesired side effect of dup @@ -379,7 +391,7 @@ begin if not udp then begin {!!! allow custom queue length? default 5} if listenqueue = 0 then listenqueue := 5; - If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise + If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise esocketexception.create('unable to listen'); state := wsListening; end else begin @@ -525,6 +537,11 @@ begin srclen := tempsrclen; end; +procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint); +begin + connectionfailedhandler(wparam); +end; + procedure tlsocket.connectionfailedhandler(error:word); begin if trymoreips then begin