X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..9036dab6e8ad5001d2354bb378096f957f8cabd6:/lsocket.pas diff --git a/lsocket.pas b/lsocket.pas index 58f157d..ddee93e 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -36,6 +36,9 @@ unit lsocket; {$ifdef fpc} {$mode delphi} {$endif} + +{$include lcoreconfig.inc} + interface uses sysutils, @@ -51,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; @@ -66,34 +76,6 @@ type 1: (S_un_w: SunW); 2: (S_addr: cardinal); end; - {$ifdef ipv6} - {$ifdef ver1_0} - cuint16=word; - cuint32=dword; - sa_family_t=word; - - - TInetSockAddr6 = packed Record - sin6_family : sa_family_t; - sin6_port : cuint16; - sin6_flowinfo : cuint32; - sin6_addr : Tin6_addr; - sin6_scope_id : cuint32; - end; - {$endif} - {$endif} - TinetSockAddrv = packed record - case integer of - 0: (InAddr:TInetSockAddr); - {$ifdef ipv6} - 1: (InAddr6:TInetSockAddr6); - {$endif} - end; - Pinetsockaddrv = ^Tinetsockaddrv; - - - type - tsockaddrin=TInetSockAddr; type TLsocket = class(tlasio) @@ -101,6 +83,12 @@ type //a: string; inAddr : TInetSockAddrV; + + biniplist:tbiniplist; + trymoreips:boolean; + currentip:integer; + connecttimeout:tltimer; + { inAddrSize:integer;} //host : THostentry ; @@ -111,16 +99,23 @@ type localaddr:string; localport:string; proto:string; - udp:boolean; + udp,dgram:boolean; listenqueue:integer; + {$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; procedure bindsocket; procedure listen; function accept : longint; - function sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer; virtual; - function receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer; virtual; - //procedure internalclose(error:word);override; + 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 handlefdtrigger(readtrigger,writetrigger:boolean); override; function send(data:pointer;len:integer):integer;override; procedure sendstr(const str : string);override; @@ -133,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; @@ -143,15 +146,6 @@ type twsocket=tlsocket; {easy} -function htons(w:word):word; -function htonl(i:integer):integer; -{!!!function longipdns(s:string):longint;} - -{$ifdef ipv6} -const - v4listendefault:boolean=false; -{$endif} - const TCP_NODELAY=1; @@ -160,155 +154,66 @@ const implementation {$include unixstuff.inc} -function longip(s:string):longint;{$ifdef fpc}inline;{$endif} -var - l:longint; - a,b:integer; -function convertbyte(const s:string):integer;{$ifdef fpc}inline;{$endif} +function tlsocket.getaddrsize:integer; begin - result := strtointdef(s,-1); - if result < 0 then exit; - if result > 255 then exit; - - {01 exception} - if (result <> 0) and (s[1] = '0') then begin - result := -1; - exit; - end; - - {+1 exception} - if not (s[1] in ['0'..'9']) then begin - result := -1; - exit - end; + result := inaddrsize(inaddr); end; -begin - result := 0; - a := pos('.',s); - if a = 0 then exit; - b := convertbyte(copy(s,1,a-1));if (b < 0) then exit; - l := b shl 24; - s := copy(s,a+1,256); - a := pos('.',s); - if a = 0 then exit; - b := convertbyte(copy(s,1,a-1));if (b < 0) then exit; - l := l or b shl 16; - s := copy(s,a+1,256); - a := pos('.',s); - if a = 0 then exit; - b := convertbyte(copy(s,1,a-1));if (b < 0) then exit; - l := l or b shl 8; - s := copy(s,a+1,256); - b := convertbyte(copy(s,1,256));if (b < 0) then exit; - l := l or b; - result := l; -end; -(*!!! -function longipdns(s:string):longint; +procedure tlsocket.realconnect; var - host : thostentry; + a,b:integer; begin - if s = '0.0.0.0' then begin - result := 0; + //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; + + 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 - result := longip(s); - if result = 0 then begin - if gethostbyname(s,host) then begin; - result := htonl(Longint(Host.Addr)); - end; - //writeln(inttohex(longint(host.addr),8)) - end; - if result = 0 then begin - if resolvehostbyname(s,host) then begin; - result := htonl(Longint(Host.Addr)); - end; - //writeln(inttohex(longint(host.addr),8)) - end; + raise ESocketException.create('unrecognised protocol'); end; -end; -*) - - -function htons(w:word):word; -begin - {$ifndef ENDIAN_BIG} - result := ((w and $ff00) shr 8) or ((w and $ff) shl 8); - {$else} - result := w; - {$endif} -end; - -function htonl(i:integer):integer; -begin - {$ifndef ENDIAN_BIG} - result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000); - {$else} - result := i; - {$endif} -end; - -function tlsocket.getaddrsize:integer; -begin - {$ifdef ipv6} - if inaddr.inaddr.family = AF_INET6 then result := sizeof(tinetsockaddr6) else - {$endif} - result := sizeof(tinetsockaddr); -end; - -function makeinaddrv(addr,port:string;var inaddr:tinetsockaddrv):integer; -var - biniptemp:tbinip; -begin - result := 0; - biniptemp := forwardlookup(addr,10); - fillchar(inaddr,sizeof(inaddr),0); - //writeln('converted address '+addr+' to binip '+ipbintostr(biniptemp)); - if biniptemp.family = AF_INET then begin - inAddr.InAddr.family:=AF_INET; - inAddr.InAddr.port:=htons(strtointdef(port,0)); - inAddr.InAddr.addr:=biniptemp.ip; - result := sizeof(tinetsockaddr); - end else - {$ifdef ipv6} - if biniptemp.family = AF_INET6 then begin - inAddr.InAddr6.sin6_family:=AF_INET6; - inAddr.InAddr6.sin6_port:=htons(strtointdef(port,0)); - inAddr.InAddr6.sin6_addr:=biniptemp.ip6; - result := sizeof(tinetsockaddr6); - end else - {$endif} - raise esocketexception.create('unable to resolve address: '+addr); -end; - -procedure tlsocket.connect; -var - a:integer; -begin - if state <> wsclosed then close; - //prevtime := 0; - makeinaddrv(addr,port,inaddr); - - udp := uppercase(proto) = 'UDP'; - if udp then a := SOCK_DGRAM else a := SOCK_STREAM; - a := Socket(inaddr.inaddr.family,a,0); + 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); + + eventcore.rmasterset(fdhandlein,false); + eventcore.wmasterclr(fdhandleout); end else begin state :=wsconnecting; {$ifdef win32} @@ -317,12 +222,9 @@ begin {$else} sockets.Connect(fdhandlein,inADDR,getaddrsize); {$endif} - end; - eventcore.rmasterset(fdhandlein,false); - if udp then begin - eventcore.wmasterclr(fdhandleout); - end else begin + eventcore.rmasterset(fdhandlein,false); eventcore.wmasterset(fdhandleout); + if trymoreips then connecttimeout.enabled := true; end; //sendq := ''; except @@ -331,11 +233,43 @@ begin raise; //reraise the exception end; end; + +end; + +procedure tlsocket.connecttimeouthandler(sender:tobject); +begin + connecttimeout.enabled := false; + destroying := true; //hack to not cause handler to trigger + internalclose(0); + destroying := false; + realconnect; +end; + +procedure tlsocket.connect; +var + a:integer; + ip:tbinip; +begin + if state <> wsclosed then close; + //prevtime := 0; + if isbiniplist(addr) then biniplist := addr else biniplist := forwardlookuplist(addr,0); + if biniplist_getcount(biniplist) = 0 then raise exception.create('unable to resolve '+addr); + + //makeinaddrv(addr,port,inaddr); + + currentip := 0; + if not assigned(connecttimeout) then begin + connecttimeout := tltimer.create(self); + connecttimeout.ontimer := connecttimeouthandler; + connecttimeout.interval := 2500; + connecttimeout.enabled := false; + end; + realconnect; end; procedure tlsocket.sendstr(const str : string); begin - if udp then begin + if dgram then begin send(@str[1],length(str)) end else begin inherited sendstr(str); @@ -344,12 +278,12 @@ end; function tlsocket.send(data:pointer;len:integer):integer; begin - if udp then begin - //writeln('sending to '+inttohex(inaddr.inaddr.addr,8)); - result := sendto(inaddr.inaddr,getaddrsize,data,len) -; - //writeln('send result',result); - //writeln('errno',errno); + if dgram then begin +// writeln('sending to '+ipbintostr(inaddrvtobinip(inaddr)),' ',htons(inaddr.inaddr.port),' ',len,' bytes'); + result := sendto(inaddr,getaddrsize,data,len); + +// writeln('send result ',result); +// writeln('errno',errno); end else begin result := inherited send(data,len); end; @@ -358,8 +292,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; @@ -381,13 +321,12 @@ begin localaddr := '0.0.0.0'; end; //gethostbyname(localaddr,host); - - inaddrtempsize := makeinaddrv(localaddr,localport,inaddrtemp); + inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp); 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; @@ -408,7 +347,10 @@ var 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 @@ -419,7 +361,7 @@ begin {$endif} addr := '0.0.0.0'; end; - biniptemp := forwardlookup(addr,10); + if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10); addr := ipbintostr(biniptemp); fdhandlein := socket(biniptemp.family,socktype,0); {$ifdef ipv6} @@ -428,7 +370,8 @@ begin fdhandlein := socket(AF_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 @@ -448,14 +391,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{$else}sockets{$endif}.Listen(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 @@ -466,18 +433,47 @@ begin fdhandlein := -1; end; end else begin - eventcore.rmasterset(fdhandlein,true); + eventcore.rmasterset(fdhandlein,not udp); end; if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout); end; - //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); + //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} @@ -488,39 +484,101 @@ begin //now we have accepted one request start monitoring for more again eventcore.rmasterset(fdhandlein,true); - if result = -1 then raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting'); + if result = -1 then begin + raise esocketexception.create('error '+inttostr({$ifdef win32}getlasterror{$else}socketerror{$endif})+' while accepting'); + end; if result > absoloutemaxs then begin myfdclose(result); + a := result; result := -1; - raise esocketexception.create('file discriptor out of range'); + raise esocketexception.create('file discriptor out of range: '+inttostr(a)); end; end; -function tlsocket.sendto(dest:TInetSockAddr;destlen:integer;data:pointer;len:integer):integer; +function tlsocket.sendto(dest:TInetSockAddrV;destlen:integer;data:pointer;len:integer):integer; var - destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute dest; + destx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute dest; begin + {$ifdef secondlistener} + 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); end; -function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddr;var srclen:integer):integer; +function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer; var - srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddr{$endif} absolute src; + tempsrc:TInetSockAddrV; + tempsrclen:integer; + srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc; + biniptemp:tbinip; +begin + {$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 := {$ifdef win32}winsock{$else}sockets{$endif}.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); begin - result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen); + if trymoreips then begin +// writeln('failed with error ',error); + connecttimeout.enabled := false; + destroying := true; + state := wsconnected; + self.internalclose(0); + destroying := false; + realconnect; + end else begin + state := wsconnected; + if assigned(onsessionconnected) then onsessionconnected(self,error); + self.internalclose(0); + recvq.del(maxlongint); + end; end; +procedure tlsocket.connectsuccesshandler; +begin + trymoreips := false; + connecttimeout.enabled := false; + if assigned(onsessionconnected) then onsessionconnected(self,0); +end; + + procedure tlsocket.handlefdtrigger(readtrigger,writetrigger:boolean); var tempbuf:array[0..receivebufsize-1] of byte; begin - //writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger); +// writeln('got a fd trigger, readtrigger=',readtrigger,' writetrigger=',writetrigger,' state=',integer(state)); if (state =wslistening) and readtrigger then begin { debugout('listening socket triggered on read');} 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; @@ -537,20 +595,17 @@ begin // the read event if not readtrigger then begin state := wsconnected; - if assigned(onsessionconnected) then onsessionconnected(self,0); + connectsuccesshandler; end else begin numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf)); if numread <> -1 then begin state := wsconnected; - if assigned(onsessionconnected) then onsessionconnected(self,0); + connectsuccesshandler; //connectread := true; recvq.add(@tempbuf,numread); end else begin - state := wsconnected; - if assigned(onsessionconnected) then onsessionconnected(self,{$ifdef win32}wsagetlasterror{$else}linuxerror{$endif}); -{ debugout('connect fail');} - self.internalclose(0); - recvq.del(maxlongint); + connectionfailedhandler({$ifdef win32}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 @@ -577,6 +632,7 @@ constructor tlsocket.Create(AOwner: TComponent); begin inherited create(aowner); closehandles := true; + trymoreips := true; end; @@ -600,15 +656,7 @@ begin {$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 - {$endif} - begin - binip.ip := addr.inaddr.addr; - end; + binip := inaddrvtobinip(addr); converttov4(binip); end; @@ -625,15 +673,7 @@ begin sockets.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; @@ -701,6 +741,6 @@ end; result := winsock.recv(fd,buf,size,0); end; {$endif} - + end.