X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/495c276d681a5b3f79d4b2af2ed36e8e5d9e993d..0a9944546bc1cf591dfce10112a4385049909f02:/lsocket.pas?ds=inline diff --git a/lsocket.pas b/lsocket.pas index f4c8349..509bf8e 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -2,10 +2,12 @@ {socket code by plugwash} -{ Copyright (C) 2005 Bas Steendijk and Peter Green - For conditions of distribution and use, see copyright notice in zlib_license.txt - which is included in the package - ----------------------------------------------------------------------------- } +{use this code for whatever you like in programs under whater licence you like + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + { changes by plugwash (20030728) * created handlefdtrigger virtual method in tlasio (overridden in tlsocket) and moved a lot of code from messageloop into it @@ -33,27 +35,16 @@ beware (20031017) unit lsocket; -{$ifdef fpc} - {$mode delphi} -{$endif} - -{$include lcoreconfig.inc} - +{$mode delphi} interface uses sysutils, - {$ifdef win32} - windows,winsock, + {$ifdef VER1_0} + linux, {$else} - - {$ifdef VER1_0} - linux, - {$else} - baseunix,unix,unixutil, - {$endif} - sockets, + baseunix,unix, {$endif} - classes,{pgdebugout,}pgtypes,lcore,fd_utils,binipstuff,dnssync; + sockets,classes,pgdebugout,pgtypes,lcore,fd_utils,binipstuff,dnssync; type sunB = packed record s_b1, s_b2, s_b3, s_b4: byte; @@ -69,6 +60,32 @@ 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; + + type + tsockaddrin=TInetSockAddr; type TLsocket = class(tlasio) @@ -76,12 +93,6 @@ type //a: string; inAddr : TInetSockAddrV; - - biniplist:tbiniplist; - trymoreips:boolean; - currentip:integer; - connecttimeout:tltimer; - { inAddrSize:integer;} //host : THostentry ; @@ -94,17 +105,13 @@ type proto:string; udp:boolean; listenqueue:integer; - procedure connectionfailedhandler(error:word); - procedure connecttimeouthandler(sender:tobject); - procedure connectsuccesshandler; function getaddrsize:integer; procedure connect; virtual; - procedure realconnect; procedure bindsocket; procedure listen; 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; + 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; procedure handlefdtrigger(readtrigger,writetrigger:boolean); override; function send(data:pointer;len:integer):integer;override; @@ -118,17 +125,13 @@ type function getXport:string; virtual; function getpeerport:string; virtual; constructor Create(AOwner: TComponent); override; - {$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 twsocket=tlsocket; {easy} - +function htons(w:word):word; +function htonl(i:integer):integer; {!!!function longipdns(s:string):longint;} {$ifdef ipv6} @@ -144,53 +147,159 @@ const implementation {$include unixstuff.inc} +function longip(s:string):longint;inline; +var + l:longint; + a,b:integer; + +function convertbyte(const s:string):integer;inline; +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; +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; +var + host : thostentry; +begin + if s = '0.0.0.0' then begin + result := 0; + 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; + end; +end; +*) + + +function htons(w:word):word; +begin + {$ifdef ENDIAN_LITTLE} + result := ((w and $ff00) shr 8) or ((w and $ff) shl 8); + {$else} + result := w; + {$endif} +end; + +function htonl(i:integer):integer; +begin + {$ifdef ENDIAN_LITTLE} + 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 - result := inaddrsize(inaddr); + {$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); + 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.realconnect; +procedure tlsocket.connect; var a:integer; - begin -// 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; + 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); - //writeln(ord(inaddr.inaddr.family)); + if a = -1 then begin - lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif}; + lasterror := socketerror; raise esocketexception.create('unable to create socket'); end; try dup(a); bindsocket; if udp then begin - {$ifndef win32} - SetSocketOptions(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} - //writeln(inaddr.inaddr.port); - winsock.Connect(fdhandlein,winsock.psockaddr(@inADDR)^,getaddrsize); - {$else} - sockets.Connect(fdhandlein,inADDR,getaddrsize); - {$endif} - eventcore.rmasterset(fdhandlein,false); - eventcore.wmasterset(fdhandleout); - if trymoreips then connecttimeout.enabled := true; + sockets.Connect(fdhandlein,inADDR,getaddrsize); + end; + rmasterset(fdhandlein); + if udp then begin + wmasterclr(fdhandleout); + end else begin + wmasterset(fdhandleout); end; //sendq := ''; except @@ -199,39 +308,6 @@ 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.Tag := integer(self); - connecttimeout.ontimer := connecttimeouthandler; - connecttimeout.interval := 2500; - connecttimeout.enabled := false; - end; - realconnect; end; procedure tlsocket.sendstr(const str : string); @@ -246,11 +322,7 @@ end; function tlsocket.send(data:pointer;len:integer):integer; begin if udp 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); + result := sendto(inaddr.inaddr,getaddrsize,data,len) end else begin result := inherited send(data,len); end; @@ -260,7 +332,7 @@ end; function tlsocket.receive(Buf:Pointer;BufSize:integer):integer; begin if udp then begin - result := myfdread(self.fdhandlein,buf^,bufsize); + result := fdread(self.fdhandlein,buf^,bufsize); end else begin result := inherited receive(buf,bufsize); end; @@ -270,7 +342,6 @@ procedure tlsocket.bindsocket; var a:integer; inAddrtemp:TInetSockAddrV; - inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; inaddrtempsize:integer; begin try @@ -283,11 +354,11 @@ begin end; //gethostbyname(localaddr,host); - inaddrtempsize := makeinaddrv(forwardlookup(localaddr,0),localport,inaddrtemp); + inaddrtempsize := makeinaddrv(localaddr,localport,inaddrtemp); - If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin + If Not Bind(fdhandlein,inaddrtemp,inaddrtempsize) Then begin state := wsclosed; - lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif}; + lasterror := socketerror; raise ESocketException.create('unable to bind, error '+inttostr(lasterror)); end; state := wsbound; @@ -320,7 +391,7 @@ begin {$endif} addr := '0.0.0.0'; end; - if isbiniplist(addr) then biniptemp := biniplist_get(addr,0) else biniptemp := forwardlookup(addr,10); + biniptemp := forwardlookup(addr,10); addr := ipbintostr(biniptemp); fdhandlein := socket(biniptemp.family,socktype,0); {$ifdef ipv6} @@ -330,18 +401,17 @@ begin end; {$endif} if fdhandlein = -1 then raise ESocketException.create('unable to create socket'); - dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things - //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup + dup(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things + fdreverse[fdhandlein] := self; 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) } - {$ifndef win32} - if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin - raise ESocketException.create('unable to set socket options'); - end; - {$endif} + if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin + raise ESocketException.create('unable to set socket options'); + end; + localaddr := addr; localport := port; bindsocket; @@ -349,106 +419,60 @@ 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 Not sockets.Listen(fdhandlein,listenqueue) Then raise esocketexception.create('unable to listen'); state := wsListening; end else begin - {$ifndef win32} - SetSocketOptions(fdhandleout, SOL_SOCKET, SO_BROADCAST, 'TRUE', Length('TRUE')); - {$endif} state := wsconnected; end; finally if state = wsclosed then begin if fdhandlein >= 0 then begin {one *can* get here without fd -beware} - eventcore.rmasterclr(fdhandlein); - myfdclose(fdhandlein); // we musnt leak file discriptors - eventcore.setfdreverse(fdhandlein,nil); + rmasterclr(fdhandlein); + fdclose(fdhandlein); // we musnt leak file discriptors + fdreverse[fdhandlein] := nil; fdhandlein := -1; end; end else begin - eventcore.rmasterset(fdhandlein,not udp); + rmasterset(fdhandlein); end; - if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout); + if fdhandleout >= 0 then wmasterclr(fdhandleout); end; - //writeln('listened on addr '+addr+':'+port+' '+proto+' using socket number ',fdhandlein); end; 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; + FromAddr : TInetSockAddr; // at this point time will tell :) begin - + rmasterset(fdhandlein); FromAddrSize := Sizeof(FromAddr); - {$ifdef win32} - result := winsock.accept(fdhandlein,@fromaddr,@fromaddrsize); - {$else} - result := sockets.accept(fdhandlein,fromaddr,fromaddrsize); - {$endif} - //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'); - end; + result := sockets.accept(fdhandlein,fromaddr,fromaddrsize); + if result = -1 then raise esocketexception.create('error '+inttostr(socketerror)+' while accepting'); if result > absoloutemaxs then begin - myfdclose(result); - a := result; + fdclose(result); result := -1; - raise esocketexception.create('file discriptor out of range: '+inttostr(a)); + raise esocketexception.create('file discriptor out of range'); 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; -begin - 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:TInetSockAddrV;var srclen:integer):integer; -var - srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute src; +function tlsocket.sendto; begin - result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen); + result := sockets.sendto(self.fdhandleout,data^,len,0,dest,destlen); end; -procedure tlsocket.connectionfailedhandler(error:word); +function tlsocket.receivefrom; begin - 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; + result := sockets.recvfrom(self.fdhandlein,data^,len,0,src,srclen); 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,' state=',integer(state)); if (state =wslistening) and readtrigger then begin { debugout('listening socket triggered on read');} - eventcore.rmasterclr(fdhandlein); + rmasterclr(fdhandlein); if assigned(onsessionAvailable) then onsessionAvailable(self,0); end; if udp and readtrigger then begin @@ -460,7 +484,7 @@ begin // code for dealing with the reults of a non-blocking connect is // rather complex // if just write is triggered it means connect suceeded - // if both read and write are triggered it can mean 2 things + // if both read and write are suceededed it can mean 2 things // 1: connect ok and data availible // 2: connect fail // to find out which you must read from the socket and look for errors @@ -468,32 +492,35 @@ begin // the read event if not readtrigger then begin state := wsconnected; - connectsuccesshandler; + if assigned(onsessionconnected) then onsessionconnected(self,0); end else begin - numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf)); + numread := fdread(fdhandlein,tempbuf,sizeof(tempbuf)); if numread <> -1 then begin state := wsconnected; - connectsuccesshandler; + if assigned(onsessionconnected) then onsessionconnected(self,0); //connectread := true; recvq.add(@tempbuf,numread); end else begin - connectionfailedhandler({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif}); - exit; + state := wsconnected; + if assigned(onsessionconnected) then onsessionconnected(self,linuxerror); +{ debugout('connect fail');} + self.internalclose(0); + recvq.del(maxlongint); 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 end; if fdhandlein >= 0 then begin if state = wsconnected then begin - eventcore.rmasterset(fdhandlein,false); + rmasterset(fdhandlein); end else begin - eventcore.rmasterclr(fdhandlein); + rmasterclr(fdhandlein); end; end; if fdhandleout >= 0 then begin if sendq.size = 0 then begin //don't clear the bit in fdswmaster if data is in the sendq - eventcore.wmasterclr(fdhandleout); + wmasterclr(fdhandleout); end; end; @@ -505,15 +532,12 @@ constructor tlsocket.Create(AOwner: TComponent); begin inherited create(aowner); closehandles := true; - trymoreips := true; 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 := sockets.getpeername(self.fdhandlein,addr,addrlen); end; procedure tlsocket.getxaddrbin(var binip:tbinip); @@ -523,12 +547,8 @@ var begin i := sizeof(addr); fillchar(addr,sizeof(addr),0); + sockets.getsocketname(self.fdhandlein,addr,i); - {$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 @@ -548,11 +568,7 @@ var begin i := sizeof(addr); fillchar(addr,sizeof(addr),0); - {$ifdef win32} - winsock.getpeername(self.fdhandlein,psockaddr(@addr)^,i); - {$else} - sockets.getpeername(self.fdhandlein,addr,i); - {$endif} + sockets.getpeername(self.fdhandlein,addr,i); binip.family := addr.inaddr.family; {$ifdef ipv6} @@ -586,50 +602,24 @@ end; function tlsocket.getXport:string; var - addr:tinetsockaddrv; + addr:tinetsockaddr; i:integer; begin i := sizeof(addr); - {$ifdef win32} - winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i); - - {$else} - sockets.getsocketname(self.fdhandlein,addr,i); - - {$endif} - result := inttostr(htons(addr.InAddr.port)); + sockets.getsocketname(self.fdhandlein,addr,i); + i := htons(addr.port); + result := inttostr(i); end; function tlsocket.getpeerport:string; var - addr:tinetsockaddrv; + addr:tinetsockaddr; i:integer; begin i := sizeof(addr); - {$ifdef win32} - winsock.getpeername(self.fdhandlein,psockaddrin(@addr)^,i); - - {$else} - sockets.getpeername(self.fdhandlein,addr,i); - - {$endif} - result := inttostr(htons(addr.InAddr.port)); + sockets.getpeername(self.fdhandlein,addr,i); + i := htons(addr.port); + result := inttostr(i); end; -{$ifdef win32} - procedure tlsocket.myfdclose(fd : integer); - begin - closesocket(fd); - end; - function tlsocket.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; - begin - result := winsock.send(fd,(@buf)^,size,0); - end; - function tlsocket.myfdread(fd: LongInt;var buf;size: LongInt):LongInt; - begin - result := winsock.recv(fd,buf,size,0); - end; -{$endif} - end. -