X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/f8e139db970666e906db30417763f81e2ae5e801..e6290c8bee34fc9a6fdbce30a9dd85faffeaac5a:/lsocket.pas?ds=inline diff --git a/lsocket.pas b/lsocket.pas index c099cf5..72ef891 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,29 +121,36 @@ 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); - private - procedure taskcallconnectionfailedhandler(wparam,lparam : longint); - procedure connecttimeouthandler(sender:tobject); - procedure connectsuccesshandler; + {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 + {$endif} + procedure taskcallconnectionfailedhandler(wparam,lparam : longint); + + procedure connecttimeouthandler(sender:tobject); + procedure connectsuccesshandler; end; tsocket=longint; // for compatibility with twsocket @@ -190,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; @@ -275,9 +288,6 @@ end; procedure tlsocket.connect; -var - a:integer; - ip:tbinip; begin if state <> wsclosed then close; //prevtime := 0; @@ -290,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)) @@ -336,7 +346,6 @@ end; procedure tlsocket.bindsocket; var - a:integer; inAddrtemp:TInetSockAddrV; inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; inaddrtempsize:integer; @@ -351,7 +360,9 @@ begin end; //gethostbyname(localaddr,host); inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp); - + {$ifdef ipv6} + isv6socket := (inaddrtemp.inaddr.family = AF_INET6); + {$endif} If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin state := wsclosed; lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif}; @@ -369,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'; @@ -384,7 +397,9 @@ begin if addr = '' then begin {$ifdef ipv6} + //writeln('ipv6 is defined'); if not v4listendefault then begin + //writeln('setting addr to ::'); addr := '::'; end else {$endif} @@ -392,11 +407,20 @@ begin end; if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10); addr := ipbintostr(biniptemp); + //writeln('after ipbintostr call addr =',addr); + //writeln('biniptemp.family =',biniptemp.family); + //writeln('AF_INET6=',AF_INET6); + //writeln('PF_INET6=',PF_INET6); + //writeln('AF_INET=',AF_INET); + //writeln('PF_INET=',PF_INET); + 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');} addr := '0.0.0.0'; - fdhandlein := socket(AF_INET,socktype,0); + biniptemp := ipstrtobinf(addr); + fdhandlein := socket(PF_INET,socktype,0); end; {$endif} @@ -406,15 +430,24 @@ 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 socket options'); + raise ESocketException.create('unable to set SO_REUSEADDR socket option'); end; - if SetSocketOptions(fdhandlein, IPPROTO_IPV6,IPV6_V6ONLY,no,sizeof(no))=-1 then begin - raise ESocketException.create('unable to set socket options'); + //writeln('addr=',addr); + //writeln('setting IPV6_V6ONLY option to 0'); + //allow v4 connections on v6 sockets + if biniptemp.family = af_inet6 then begin + if SetSocketOptions(fdhandlein, IPPROTO_IPV6,IPV6_V6ONLY,no,sizeof(no))=-1 then begin + writeln(IPPROTO_IPV6); + writeln(IPV6_V6ONLY); + raise ESocketException.create('unable to set IPV6_V6ONLY socket option error='+inttostr(socketerror)); + + end; end; {$endif} localaddr := addr; @@ -523,7 +556,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; @@ -531,15 +564,33 @@ end; function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer; var - destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute dest; + {$ifdef ipv6} + realdest : tinetsockaddrv; + biniptemp : tbinip; + {$endif} + destx : {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}; + begin {$ifdef secondlistener} - if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin - result := secondlistener.sendto(dest,destlen,data,len); - exit; - end; + if assigned(secondlistener) then if (dest.inaddr.family = AF_INET) then begin + result := secondlistener.sendto(dest,destlen,data,len); + exit; + end; + {$endif} + {$ifdef ipv6} + if isv6socket then begin + biniptemp := inaddrvtobinip(dest); + converttov6(biniptemp); + destlen := makeinaddrv(biniptemp,inttostr(ntohs(dest.InAddr.port)),realdest); + destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@realdest) + end else begin + destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest) + end; + {$else} + destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest) {$endif} - result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx,destlen); + + result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx^,destlen); end; @@ -713,7 +764,7 @@ begin converttov4(binip); end; -function tlsocket.getXaddr:string; +function tlsocket.getXaddr:thostname; var biniptemp:tbinip; begin @@ -722,7 +773,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getpeeraddr:string; +function tlsocket.getpeeraddr:thostname; var biniptemp:tbinip; begin @@ -731,7 +782,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getXport:string; +function tlsocket.getXport:ansistring; var addr:tinetsockaddrv; i:integer; @@ -747,7 +798,7 @@ begin result := inttostr(htons(addr.InAddr.port)); end; -function tlsocket.getpeerport:string; +function tlsocket.getpeerport:ansistring; var addr:tinetsockaddrv; i:integer;