X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/46424de88e9de51a8151fd6ef813ff7827b1ad8c..b75c4f1cb9e048c35d3242cece45de07eb43282e:/lsocket.pas

diff --git a/lsocket.pas b/lsocket.pas
index af3faf8..a7c6164 100755
--- a/lsocket.pas
+++ b/lsocket.pas
@@ -94,11 +94,11 @@ 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;
       {$ifdef secondlistener}
@@ -118,20 +118,23 @@ 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
+      {$ifdef ipv6}
+        isv6socket : boolean; //identifies if the socket is v6, set by bindsocket
+      {$endif}
       procedure taskcallconnectionfailedhandler(wparam,lparam : longint);
 
       procedure connecttimeouthandler(sender:tobject);
@@ -177,10 +180,6 @@ end;
   begin
     result := getpeername(sock,addr,addrlen);
   end;
-  function system_getsocketname(Sock: LongInt;var Addr;var Addrlen: LongInt):LongInt;
-  begin
-    result := getsocketname(sock,addr,addrlen);
-  end;
   function system_listen(Sock: LongInt; MaxConnect: LongInt):Boolean;
   begin
     result := listen(sock,maxconnect);
@@ -300,7 +299,7 @@ begin
   realconnect;
 end;
 
-procedure tlsocket.sendstr(const str : string);
+procedure tlsocket.sendstr(const str : tbufferstring);
 begin
   if dgram then begin
     send(@str[1],length(str))
@@ -355,7 +354,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};
@@ -373,10 +374,10 @@ 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';
@@ -388,7 +389,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}
@@ -396,11 +399,19 @@ 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}
 
@@ -412,9 +423,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;
@@ -531,15 +554,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}
-  result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(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 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;
 
 
@@ -690,7 +731,7 @@ begin
   {$ifdef win32}
     winsock.getsockname(self.fdhandlein,psockaddr(@addr)^,i);
   {$else}
-    system_getsocketname(self.fdhandlein,addr,i);
+    getsocketname(self.fdhandlein,addr,i);
   {$endif}
   binip := inaddrvtobinip(addr);
   converttov4(binip);
@@ -713,7 +754,7 @@ begin
   converttov4(binip);
 end;
 
-function tlsocket.getXaddr:string;
+function tlsocket.getXaddr:thostname;
 var
   biniptemp:tbinip;
 begin
@@ -722,7 +763,7 @@ begin
   if result = '' then result := 'error';
 end;
 
-function tlsocket.getpeeraddr:string;
+function tlsocket.getpeeraddr:thostname;
 var
   biniptemp:tbinip;
 begin
@@ -731,7 +772,7 @@ begin
   if result = '' then result := 'error';
 end;
 
-function tlsocket.getXport:string;
+function tlsocket.getXport:ansistring;
 var
   addr:tinetsockaddrv;
   i:integer;
@@ -741,13 +782,13 @@ begin
     winsock.getsockname(self.fdhandlein,psockaddrin(@addr)^,i);
 
   {$else}
-    system_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;