X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/2dd575b95694c126013c912526093ff4915f3398..1c8b91ca0f6891a397357c7cf7d77af18c15937d:/lsocket.pas?ds=sidebyside diff --git a/lsocket.pas b/lsocket.pas old mode 100755 new mode 100644 index 18e7658..6a4034d --- a/lsocket.pas +++ b/lsocket.pas @@ -22,7 +22,7 @@ changes by beware (20030903) beware (20030905) * if connect failed (conn refused) set state to connected and call internalclose, to get closed handler (instead of fdclose) -* (lcore) if closing the fd's in internalcose, set fd's to -1 because closing an fd makes it invalid +* (lcore) if closing the fd's in internalclose, set fds to -1 because closing an fd makes it invalid beware (20030927) * fixed: on connect failed, tried to close fdhandle's which were already set to -1, added check @@ -42,7 +42,7 @@ unit lsocket; interface uses sysutils, - {$ifdef win32} + {$ifdef mswindows} windows,winsock, {$else} @@ -93,14 +93,17 @@ type //host : THostentry ; - //mainthread : boolean ; //for debuggin only - addr:string; - port:string; - localaddr:string; - localport:string; - proto:string; + //mainthread : boolean ; //for debugging only + 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; - {$ifdef win32} + {public in tlasio, and can't be private in both places, so should be public here. + fixes delphi warning --beware} + {$ifdef mswindows} 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 @@ -160,13 +170,42 @@ 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 mswindows} + 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,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; @@ -181,7 +220,6 @@ begin a := SOCK_STREAM; dgram := false; end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin - //note: ICMP support doesn't seem to work yet b := strtointdef(proto,IPPROTO_ICMP); a := SOCK_RAW; dgram := true; @@ -198,14 +236,14 @@ begin //we want internalclose to act as if there was fdhandlein := -2; fdhandleout := -2; - tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0); + tltask.create(taskcallconnectionfailedhandler,self,{$ifdef mswindows}wsagetlasterror{$else}socketerror{$endif},0); exit; end; try dup(a); bindsocket; if dgram then begin - {$ifndef win32} + {$ifndef mswindows} SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); {$else} SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); @@ -217,14 +255,17 @@ begin eventcore.wmasterclr(fdhandleout); end else begin state :=wsconnecting; - {$ifdef win32} + {$ifdef mswindows} + //beware: atleast on windows, wsaasyncselect set interest in events before connecting, or a connect error isn't seen if it happens immediately during connect + eventcore.rmasterset(fdhandlein,false); + eventcore.wmasterset(fdhandleout); //writeln(inaddr.inaddr.port); winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize); {$else} - sockets.Connect(fdhandlein,inADDR,getaddrsize); + system_Connect(fdhandlein,inADDR,getaddrsize); + eventcore.rmasterset(fdhandlein,false); + eventcore.wmasterset(fdhandleout); {$endif} - eventcore.rmasterset(fdhandlein,false); - eventcore.wmasterset(fdhandleout); if trymoreips then connecttimeout.enabled := true; end; //sendq := ''; @@ -246,10 +287,10 @@ begin realconnect; end; + + + procedure tlsocket.connect; -var - a:integer; - ip:tbinip; begin if state <> wsclosed then close; //prevtime := 0; @@ -261,15 +302,14 @@ 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 dgram then begin send(@str[1],length(str)) @@ -309,9 +349,8 @@ end; procedure tlsocket.bindsocket; var - a:integer; inAddrtemp:TInetSockAddrV; - inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; + inAddrtempx:{$ifdef mswindows}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; inaddrtempsize:integer; begin try @@ -324,10 +363,12 @@ begin end; //gethostbyname(localaddr,host); inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp); - - If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin + {$ifdef ipv6} + isv6socket := (inaddrtemp.inaddr.family = AF_INET6); + {$endif} + If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef mswindows}0{$else}true{$endif} Then begin state := wsclosed; - lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif}; + lasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif}; raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror)); end; state := wsbound; @@ -342,10 +383,12 @@ end; procedure tlsocket.listen; var - yes:longint; + {$ifndef mswindows} + yes,no:longint; + {$endif} socktype:integer; biniptemp:tbinip; - origaddr:string; + origaddr:thostname; begin if state <> wsclosed then close; udp := uppercase(proto) = 'UDP'; @@ -357,7 +400,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} @@ -365,26 +410,51 @@ 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} - if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif}); + if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef mswindows}+' 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 try - yes := $01010101; {Copied this from existing code. Value is empiric, + {$ifndef mswindows} + yes := $01010101; {Copied this from existing code. Value is empiric, but works. (yes=true<>0) } - {$ifndef win32} + 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; + //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; + {$else} + SetSockOpt(fdhandlein, SOL_SOCKET, SO_REUSEADDR, 'TRUE', Length('TRUE')); + {$endif} localaddr := addr; localport := port; @@ -393,11 +463,11 @@ 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 mswindows}winsock.listen{$else}system_listen{$endif}(fdhandlein,listenqueue)<>{$ifdef mswindows}0{$else}true{$endif} Then raise esocketexception.create('unable to listen'); state := wsListening; end else begin - {$ifndef win32} + {$ifndef mswindows} SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); {$else} SetSockOpt(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); @@ -430,7 +500,7 @@ esocketexception.create('unable to listen'); if fdhandlein >= 0 then begin {one *can* get here without fd -beware} eventcore.rmasterclr(fdhandlein); - myfdclose(fdhandlein); // we musnt leak file discriptors + myfdclose(fdhandlein); // we musnt leak file descriptors eventcore.setfdreverse(fdhandlein,nil); fdhandlein := -1; end; @@ -465,9 +535,9 @@ end; function tlsocket.accept : longint; var - FromAddrSize : LongInt; // i don't realy know what to do with these at this + FromAddrSize : LongInt; // i don't really know what to do with these at this FromAddr : TInetSockAddrV; // at this point time will tell :) - a:integer; + a,acceptlasterror:integer; begin {$ifdef secondlistener} if (lastsessionfromsecond) then begin @@ -478,43 +548,66 @@ begin {$endif} FromAddrSize := Sizeof(FromAddr); - {$ifdef win32} + {$ifdef mswindows} result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize); {$else} - result := sockets.accept(fdhandlein,fromaddr,fromaddrsize); + result := system_accept(fdhandlein,fromaddr,fromaddrsize); {$endif} + + if (result = -1) then acceptlasterror := {$ifdef mswindows}getlasterror{$else}socketerror{$endif} else acceptlasterror := 0; + //now we have accepted one request start monitoring for more again eventcore.rmasterset(fdhandlein,true); if result = -1 then begin - raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting'); + raise esocketexception.create('error '+inttostr(acceptlasterror)+' while accepting'); end; - if result > absoloutemaxs then begin + if result > absolutemaxs then begin myfdclose(result); a := result; - result := -1; - raise esocketexception.create('file discriptor out of range: '+inttostr(a)); +{ result := -1;} + raise esocketexception.create('file descriptor out of range: '+inttostr(a)); 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 mswindows}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} - result := {$ifdef win32}winsock{$else}sockets{$endif}.sendto(self.fdhandleout,data^,len,0,destx,destlen); + {$ifdef ipv6} + if isv6socket then begin + biniptemp := inaddrvtobinip(dest); + converttov6(biniptemp); + destlen := makeinaddrv(biniptemp,inttostr(ntohs(dest.InAddr.port)),realdest); + destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@realdest) + end else begin + destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest) + end; + {$else} + destx := {$ifdef mswindows}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest); + {$endif} + + result := {$ifdef mswindows}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 tempsrc:TInetSockAddrV; tempsrclen:integer; - srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc; + srcx : {$ifdef mswindows}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc; biniptemp:tbinip; begin {$ifdef secondlistener} @@ -525,7 +618,7 @@ begin end; {$endif} tempsrclen := sizeof(tempsrc); - result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen); + result := recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen); {$ifdef ipv6} biniptemp := inaddrvtobinip(tempsrc); @@ -586,14 +679,14 @@ begin exit; end; if (state =wsconnecting) and writetrigger then begin - // code for dealing with the reults of a non-blocking connect is + // code for dealing with the results of a non-blocking connect is // rather complex - // if just write is triggered it means connect suceeded + // if just write is triggered it means connect succeeded // if both read and write are triggered it can mean 2 things - // 1: connect ok and data availible + // 1: connect ok and data available // 2: connect fail // to find out which you must read from the socket and look for errors - // there if we read successfully we drop through into the code for fireing + // there if we read successfully we drop through into the code for firing // the read event if not readtrigger then begin state := wsconnected; @@ -606,11 +699,11 @@ begin //connectread := true; recvq.add(@tempbuf,numread); end else begin - connectionfailedhandler({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif}); + connectionfailedhandler({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif}); exit; end; // if things went well here we are now in the state wsconnected with data sitting in our receive buffer - // so we drop down into the processing for data availible + // so we drop down into the processing for data available end; if fdhandlein >= 0 then begin if state = wsconnected then begin @@ -638,11 +731,12 @@ begin end; + function tlsocket.getpeername(var addr:tsockaddrin;addrlen:integer):integer; var - addrx : {$ifdef win32}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr; + addrx : {$ifdef mswindows}winsock.tsockaddr{$else}tsockaddrin{$endif} absolute addr; begin - result := {$ifdef win32}winsock{$else}sockets{$endif}.getpeername(self.fdhandlein,addrx,addrlen); + result := {$ifdef mswindows}winsock.getpeername{$else}system_getpeername{$endif}(self.fdhandlein,addrx,addrlen); end; procedure tlsocket.getxaddrbin(var binip:tbinip); @@ -653,10 +747,10 @@ begin i := sizeof(addr); fillchar(addr,sizeof(addr),0); - {$ifdef win32} + {$ifdef mswindows} winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i); {$else} - sockets.getsocketname(self.fdhandlein,addr,i); + getsocketname(self.fdhandlein,addr,i); {$endif} binip := inaddrvtobinip(addr); converttov4(binip); @@ -669,17 +763,17 @@ var begin i := sizeof(addr); fillchar(addr,sizeof(addr),0); - {$ifdef win32} + {$ifdef mswindows} winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i); {$else} - sockets.getpeername(self.fdhandlein,addr,i); + system_getpeername(self.fdhandlein,addr,i); {$endif} binip := inaddrvtobinip(addr); converttov4(binip); end; -function tlsocket.getXaddr:string; +function tlsocket.getXaddr:thostname; var biniptemp:tbinip; begin @@ -688,7 +782,7 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getpeeraddr:string; +function tlsocket.getpeeraddr:thostname; var biniptemp:tbinip; begin @@ -697,39 +791,39 @@ begin if result = '' then result := 'error'; end; -function tlsocket.getXport:string; +function tlsocket.getXport:ansistring; var addr:tinetsockaddrv; i:integer; begin i := sizeof(addr); - {$ifdef win32} + {$ifdef mswindows} 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; begin i := sizeof(addr); - {$ifdef win32} + {$ifdef mswindows} 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)); end; -{$ifdef win32} +{$ifdef mswindows} procedure tlsocket.myfdclose(fd : integer); begin closesocket(fd);