X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/82d4e52fba54be50d719f6185ec381f2dc87fc6c..6e5673aa1dcdb1ba7688b75f7f065353abc86159:/lsocket.pas diff --git a/lsocket.pas b/lsocket.pas index c37a66a..bcff643 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -54,6 +54,13 @@ interface sockets, {$endif} classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync; + +{$ifdef ipv6} +const + v4listendefault:boolean=false; +{$endif} + + type sunB = packed record s_b1, s_b2, s_b3, s_b4: byte; @@ -87,16 +94,22 @@ type //host : THostentry ; //mainthread : boolean ; //for debuggin only - addr:string; - port:string; - localaddr:string; - localport:string; - proto:string; - udp:boolean; + addr:thostname; + port:ansistring; + localaddr:thostname; + localport:ansistring; + proto:ansistring; + udp,dgram:boolean; listenqueue:integer; - procedure connectionfailedhandler(error:word); - procedure connecttimeouthandler(sender:tobject); - procedure connectsuccesshandler; + + onconnecttryip:procedure(sender:tobject; const ip:tbinip) of object; + + {$ifdef secondlistener} + secondlistener:tlsocket; + lastsessionfromsecond:boolean; + procedure secondaccepthandler(sender:tobject;error:word); + procedure internalclose(error:word);override; + {$endif} function getaddrsize:integer; procedure connect; virtual; procedure realconnect; @@ -105,19 +118,30 @@ type function accept : longint; function sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer; virtual; function receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer; virtual; - //procedure internalclose(error:word);override; + 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 + {$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; {$ifdef win32} procedure myfdclose(fd : integer); override; function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; @@ -129,14 +153,6 @@ type twsocket=tlsocket; {easy} -{!!!function longipdns(s:string):longint;} - -{$ifdef ipv6} -const - v4listendefault:boolean=false; -{$endif} - - const TCP_NODELAY=1; IPPROTO_TCP=6; @@ -150,30 +166,83 @@ begin result := inaddrsize(inaddr); end; +//I used to use the system versions of these from within lsocket (which has +//functions whose name clashes with them) by using sockets.* and but I can't do +//that anymore since in some cases connect is now provided by unixstuff.inc +//hence these wrapper functions --plugwash +{$ifndef win32} + function system_Connect(Sock: LongInt;const Addr;Addrlen: LongInt):Boolean; + begin + result := connect(sock,addr,addrlen); + end; + function system_SendTo(Sock: LongInt; const Buf;BufLen: LongInt;Flags: LongInt;var Addr;AddrLen: LongInt):LongInt; + begin + result := sendto(sock,buf,buflen,flags,addr,addrlen); + end; + function system_getpeername(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt; + begin + result := getpeername(sock,addr,addrlen); + end; + function system_listen(Sock: LongInt; MaxConnect: LongInt):Boolean; + begin + result := listen(sock,maxconnect); + end; + function system_Accept(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt; + begin + result := accept(sock,addr,addrlen); + end; +{$endif} procedure tlsocket.realconnect; var - a:integer; - + a,b:integer; + iptemp:tbinip; begin -// writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port); - makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr); + iptemp := biniplist_get(biniplist,currentip); + //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port); + if assigned(onconnecttryip) then onconnecttryip(self,iptemp); + makeinaddrv(iptemp,port,inaddr); inc(currentip); if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false; - udp := uppercase(proto) = 'UDP'; - if udp then a := SOCK_DGRAM else a := SOCK_STREAM; - a := Socket(inaddr.inaddr.family,a,0); + + udp := false; + if (uppercase(proto) = 'UDP') then begin + b := IPPROTO_UDP; + a := SOCK_DGRAM; + udp := true; + dgram := true; + end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin + b := IPPROTO_TCP; + a := SOCK_STREAM; + dgram := false; + 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); bindsocket; - if udp then begin + if dgram then begin {$ifndef win32} SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); + {$else} + SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); {$endif} state := wsconnected; if assigned(onsessionconnected) then onsessionconnected(self,0); @@ -186,7 +255,7 @@ begin //writeln(inaddr.inaddr.port); winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize); {$else} - sockets.Connect(fdhandlein,inADDR,getaddrsize); + system_Connect(fdhandlein,inADDR,getaddrsize); {$endif} eventcore.rmasterset(fdhandlein,false); eventcore.wmasterset(fdhandleout); @@ -211,6 +280,9 @@ begin realconnect; end; + + + procedure tlsocket.connect; var a:integer; @@ -226,17 +298,16 @@ begin currentip := 0; if not assigned(connecttimeout) then begin connecttimeout := tltimer.create(self); - connecttimeout.Tag := integer(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 udp then begin + if dgram then begin send(@str[1],length(str)) end else begin inherited sendstr(str); @@ -245,7 +316,7 @@ end; function tlsocket.send(data:pointer;len:integer):integer; begin - if udp then begin + if dgram then begin // writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes'); result := sendto(inaddr,getaddrsize,data,len); @@ -259,8 +330,14 @@ end; function tlsocket.receive(Buf:Pointer;BufSize:integer):integer; begin - if udp then begin - result := myfdread(self.fdhandlein,buf^,bufsize); + if dgram then begin + {$ifdef secondlistener} + if lastsessionfromsecond then begin + result := secondlistener.receive(buf,bufsize); + lastsessionfromsecond := false; + end else + {$endif} + result := myfdread(self.fdhandlein,buf^,bufsize); end else begin result := inherited receive(buf,bufsize); end; @@ -282,13 +359,14 @@ begin localaddr := '0.0.0.0'; 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}; - raise ESocketException.create('unable to bind, error '+inttostr(lasterror)); + raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror)); end; state := wsbound; end; @@ -302,19 +380,24 @@ end; procedure tlsocket.listen; var - yes:longint; + yes,no:longint; socktype:integer; biniptemp:tbinip; - origaddr:string; + origaddr:thostname; begin if state <> wsclosed then close; udp := uppercase(proto) = 'UDP'; - if udp then socktype := SOCK_DGRAM else socktype := SOCK_STREAM; + if udp then begin + socktype := SOCK_DGRAM; + dgram := true; + end else socktype := SOCK_STREAM; origaddr := addr; if addr = '' then begin {$ifdef ipv6} + //writeln('ipv6 is defined'); if not v4listendefault then begin + //writeln('setting addr to ::'); addr := '::'; end else {$endif} @@ -322,14 +405,23 @@ 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); + fdhandlein := socket(PF_INET,socktype,0); 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 @@ -337,9 +429,21 @@ begin try yes := $01010101; {Copied this from existing code. Value is empiric, but works. (yes=true<>0) } + no := 0; {$ifndef win32} 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; + //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; @@ -349,14 +453,38 @@ 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 esocketexception.create('unable to listen'); + If {$ifdef win32}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise +esocketexception.create('unable to listen'); state := wsListening; end else begin {$ifndef win32} SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); + {$else} + SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); {$endif} state := wsconnected; end; + + {$ifdef secondlistener} + //listening on ::. try to listen on 0.0.0.0 as well for platforms which don't already do that + if addr = '::' then begin + secondlistener := tlsocket.create(nil); + secondlistener.proto := proto; + secondlistener.addr := '0.0.0.0'; + secondlistener.port := port; + if udp then begin + secondlistener.ondataavailable := secondaccepthandler; + end else begin + secondlistener.onsessionAvailable := secondaccepthandler; + end; + try + secondlistener.listen; + except + secondlistener.destroy; + secondlistener := nil; + end; + end; + {$endif} finally if state = wsclosed then begin if fdhandlein >= 0 then begin @@ -374,18 +502,46 @@ begin //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); end; +{$ifdef secondlistener} +procedure tlsocket.internalclose(error:word); +begin + if assigned(secondlistener) then begin + secondlistener.destroy; + secondlistener := nil; + end; + inherited internalclose(error); +end; + +procedure tlsocket.secondaccepthandler; +begin + lastsessionfromsecond := true; + if udp then begin + ondataavailable(self,error); + end else begin + if assigned(onsessionavailable) then onsessionavailable(self,error); + end; +end; +{$endif} + function tlsocket.accept : longint; var FromAddrSize : LongInt; // i don't realy know what to do with these at this FromAddr : TInetSockAddrV; // at this point time will tell :) a:integer; begin + {$ifdef secondlistener} + if (lastsessionfromsecond) then begin + lastsessionfromsecond := false; + result := secondlistener.accept; + exit; + end; + {$endif} FromAddrSize := Sizeof(FromAddr); {$ifdef win32} result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize); {$else} - result := sockets.accept(fdhandlein,fromaddr,fromaddrsize); + result := system_accept(fdhandlein,fromaddr,fromaddrsize); {$endif} //now we have accepted one request start monitoring for more again eventcore.rmasterset(fdhandlein,true); @@ -401,18 +557,71 @@ begin end; 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 - result := {$ifdef win32}winsock{$else}sockets{$endif}.sendto(self.fdhandleout,data^,len,0,destx,destlen); + {$ifdef secondlistener} + 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); end; + function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer; var - srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute src; + tempsrc:TInetSockAddrV; + tempsrclen:integer; + srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc; + biniptemp:tbinip; begin - result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen); + {$ifdef secondlistener} + if assigned(secondlistener) then if lastsessionfromsecond then begin + lastsessionfromsecond := false; + result := secondlistener.receivefrom(data,len,src,srclen); + exit; + end; + {$endif} + tempsrclen := sizeof(tempsrc); + result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen); + + {$ifdef ipv6} + biniptemp := inaddrvtobinip(tempsrc); + if needconverttov4(biniptemp) then begin + converttov4(biniptemp); + tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc); + end; + {$endif} + + move(tempsrc,src,srclen); + srclen := tempsrclen; +end; + +procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint); +begin + connectionfailedhandler(wparam); end; procedure tlsocket.connectionfailedhandler(error:word); @@ -451,7 +660,7 @@ begin eventcore.rmasterclr(fdhandlein); if assigned(onsessionAvailable) then onsessionAvailable(self,0); end; - if udp and readtrigger then begin + if dgram and readtrigger then begin if assigned(ondataAvailable) then ondataAvailable(self,0); {!!!test} exit; @@ -509,11 +718,12 @@ begin end; + function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer; var addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr; begin - result := {$ifdef win32}winsock{$else}sockets{$endif}.getpeername(self.fdhandlein,addrx,addrlen); + result := {$ifdef win32}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen); end; procedure tlsocket.getxaddrbin(var binip:tbinip); @@ -527,17 +737,9 @@ begin {$ifdef win32} winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i); {$else} - sockets.getsocketname(self.fdhandlein,addr,i); - {$endif} - binip.family := addr.inaddr.family; - {$ifdef ipv6} - if addr.inaddr6.sin6_family = AF_INET6 then begin - binip.ip6 := addr.inaddr6.sin6_addr; - end else + getsocketname(self.fdhandlein,addr,i); {$endif} - begin - binip.ip := addr.inaddr.addr; - end; + binip := inaddrvtobinip(addr); converttov4(binip); end; @@ -551,22 +753,14 @@ begin {$ifdef win32} winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i); {$else} - sockets.getpeername(self.fdhandlein,addr,i); + system_getpeername(self.fdhandlein,addr,i); {$endif} - binip.family := addr.inaddr.family; - {$ifdef ipv6} - if addr.inaddr6.sin6_family = AF_INET6 then begin - binip.ip6 := addr.inaddr6.sin6_addr; - end else - {$endif} - begin - binip.ip := addr.inaddr.addr; - end; + binip := inaddrvtobinip(addr); converttov4(binip); end; -function tlsocket.getXaddr:string; +function tlsocket.getXaddr:thostname; var biniptemp:tbinip; begin @@ -575,7 +769,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getpeeraddr:string; +function tlsocket.getpeeraddr:thostname; var biniptemp:tbinip; begin @@ -584,7 +778,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getXport:string; +function tlsocket.getXport:ansistring; var addr:tinetsockaddrv; i:integer; @@ -594,13 +788,13 @@ begin winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i); {$else} - sockets.getsocketname(self.fdhandlein,addr,i); + getsocketname(self.fdhandlein,addr,i); {$endif} result := inttostr(htons(addr.InAddr.port)); end; -function tlsocket.getpeerport:string; +function tlsocket.getpeerport:ansistring; var addr:tinetsockaddrv; i:integer; @@ -610,7 +804,7 @@ begin winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i); {$else} - sockets.getpeername(self.fdhandlein,addr,i); + system_getpeername(self.fdhandlein,addr,i); {$endif} result := inttostr(htons(addr.InAddr.port));