X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/931a750a50f8191665d56c1ec341f6892f1f026c..9eaeac69829469108bce954ccce0710bbdb27fb3:/lsocket.pas?ds=sidebyside diff --git a/lsocket.pas b/lsocket.pas index 7f61092..642ec9a 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -94,13 +94,16 @@ type //host : THostentry ; //mainthread : boolean ; //for debuggin only - addr:string; - port:string; - localaddr:string; - localport:string; - proto:string; + addr:thostname; + port:ansistring; + localaddr:thostname; + localport:ansistring; + proto:ansistring; udp,dgram:boolean; listenqueue:integer; + + onconnecttryip:procedure(sender:tobject; const ip:tbinip) of object; + {$ifdef secondlistener} secondlistener:tlsocket; lastsessionfromsecond:boolean; @@ -118,19 +121,28 @@ type procedure handlefdtrigger(readtrigger,writetrigger:boolean); override; function send(data:pointer;len:integer):integer;override; - procedure sendstr(const str : string);override; + procedure sendstr(const str : tbufferstring);override; function Receive(Buf:Pointer;BufSize:integer):integer; override; function getpeername(var addr:tsockaddrin;addrlen:integer):integer; virtual; procedure getXaddrbin(var binip:tbinip); virtual; procedure getpeeraddrbin(var binip:tbinip); virtual; - function getXaddr:string; virtual; - function getpeeraddr:string; virtual; - function getXport:string; virtual; - function getpeerport:string; virtual; + function getXaddr:thostname; virtual; + function getpeeraddr:thostname; virtual; + function getXport:ansistring; virtual; + function getpeerport:ansistring; virtual; constructor Create(AOwner: TComponent); override; //this one has to be kept public for now because lcorewsaasyncselect calls it procedure connectionfailedhandler(error:word); + + {public in tlasio, and can't be private in both places, so should be public here. + fixes delphi warning --beware} + {$ifdef win32} + procedure myfdclose(fd : integer); override; + function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; + function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override; + {$endif} + private {$ifdef ipv6} isv6socket : boolean; //identifies if the socket is v6, set by bindsocket @@ -139,11 +151,6 @@ type procedure connecttimeouthandler(sender:tobject); procedure connectsuccesshandler; - {$ifdef win32} - procedure myfdclose(fd : integer); override; - function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; - function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override; - {$endif} end; tsocket=longint; // for compatibility with twsocket @@ -193,9 +200,12 @@ end; procedure tlsocket.realconnect; var a,b:integer; + iptemp:tbinip; begin + iptemp := biniplist_get(biniplist,currentip); //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port); - makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr); + if assigned(onconnecttryip) then onconnecttryip(self,iptemp); + makeinaddrv(iptemp,port,inaddr); inc(currentip); if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false; @@ -278,9 +288,6 @@ end; procedure tlsocket.connect; -var - a:integer; - ip:tbinip; begin if state <> wsclosed then close; //prevtime := 0; @@ -293,13 +300,13 @@ begin if not assigned(connecttimeout) then begin connecttimeout := tltimer.create(self); connecttimeout.ontimer := connecttimeouthandler; - connecttimeout.interval := 2500; + connecttimeout.interval := 5000; connecttimeout.enabled := false; end; realconnect; end; -procedure tlsocket.sendstr(const str : string); +procedure tlsocket.sendstr(const str : tbufferstring); begin if dgram then begin send(@str[1],length(str)) @@ -339,7 +346,6 @@ end; procedure tlsocket.bindsocket; var - a:integer; inAddrtemp:TInetSockAddrV; inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; inaddrtempsize:integer; @@ -374,10 +380,12 @@ end; procedure tlsocket.listen; var + {$ifndef win32} yes,no:longint; + {$endif} socktype:integer; biniptemp:tbinip; - origaddr:string; + origaddr:thostname; begin if state <> wsclosed then close; udp := uppercase(proto) = 'UDP'; @@ -409,7 +417,7 @@ begin fdhandlein := socket(biniptemp.family,socktype,0); {$ifdef ipv6} if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin - writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead'); + {writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead');} addr := '0.0.0.0'; fdhandlein := socket(PF_INET,socktype,0); end; @@ -421,10 +429,11 @@ begin state := wsclosed; // then set this back as it was an undesired side effect of dup try - yes := $01010101; {Copied this from existing code. Value is empiric, - but works. (yes=true<>0) } - no := 0; {$ifndef win32} + yes := $01010101; {Copied this from existing code. Value is empiric, + but works. (yes=true<>0) } + no := 0; + if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin raise ESocketException.create('unable to set SO_REUSEADDR socket option'); end; @@ -546,7 +555,7 @@ begin if result > absoloutemaxs then begin myfdclose(result); a := result; - result := -1; +{ result := -1;} raise esocketexception.create('file discriptor out of range: '+inttostr(a)); end; end; @@ -754,7 +763,7 @@ begin converttov4(binip); end; -function tlsocket.getXaddr:string; +function tlsocket.getXaddr:thostname; var biniptemp:tbinip; begin @@ -763,7 +772,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getpeeraddr:string; +function tlsocket.getpeeraddr:thostname; var biniptemp:tbinip; begin @@ -772,7 +781,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getXport:string; +function tlsocket.getXport:ansistring; var addr:tinetsockaddrv; i:integer; @@ -788,7 +797,7 @@ begin result := inttostr(htons(addr.InAddr.port)); end; -function tlsocket.getpeerport:string; +function tlsocket.getpeerport:ansistring; var addr:tinetsockaddrv; i:integer;