From 2dd575b95694c126013c912526093ff4915f3398 Mon Sep 17 00:00:00 2001
From: plugwash <plugwash@p10link.net>
Date: Sat, 31 Jan 2009 00:58:54 +0000
Subject: [PATCH 1/1] * various fixups resulting from getting the test app
 working on a XP   system without ipv6 enabled using delphi 3  * make failures
 to create the socket go through the async error    handling system so they
 interact well with the address list    system (making use of an address list
 with mixed v4 and v6    addresses work on a v4 only system)  * fixup some
 unit dependencies  * fixup some bits in the test app itself, make the test
 app able to    complete on a system without ipv6 enabled, make the test app  
  buildable on windows.  * fixup handling of blank and unknown protocols
 (blank gives TCP,    unknown gives an error)  * disable word size check in
 lcorerng

* make some stuff that really shouldn't be pulic private, more should
  probablly be done later in this regard



git-svn-id: file:///svnroot/lcore/trunk@32 b1de8a11-f9be-4011-bde0-cc7ace90066a
---
 lcore.pas     |  3 +++
 lcorernd.pas  |  7 +++----
 lcoretest.dpr | 37 ++++++++++++++++++++++++++-----------
 lmessages.pas |  5 +++++
 lsocket.pas   | 39 +++++++++++++++++++++++++++++----------
 5 files changed, 66 insertions(+), 25 deletions(-)

diff --git a/lcore.pas b/lcore.pas
index 7db6b3e..727ca1c 100755
--- a/lcore.pas
+++ b/lcore.pas
@@ -405,6 +405,9 @@ end;
 procedure tlasio.internalclose(error:word);
 begin
   if (state<>wsclosed) and (state<>wsinvalidstate) then begin
+    // -2 is a special indication that we should just exist silently
+    // (used for connect failure handling when socket creation fails)
+    if (fdhandlein = -2) and (fdhandleout = -2) then exit;
     if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
     eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
     eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
diff --git a/lcorernd.pas b/lcorernd.pas
index 006f6ce..643de3a 100644
--- a/lcorernd.pas
+++ b/lcorernd.pas
@@ -132,7 +132,7 @@ implementation
 
 {$ifndef nolcorernd}
 uses
-  {$ifdef win32}windows,activex,types,{$endif}
+  {$ifdef win32}windows,activex,{$endif}
   {$ifdef unix}baseunix,unix,unixutil,{$endif}
   fastmd5,sysutils;
 
@@ -145,9 +145,8 @@ type
 const
   wordsizeshift=2;
   wordsize=1 shl wordsizeshift;
-
-  {$if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{$ifend}
-
+  //wordsize check commented out for d3 compatibility
+  //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}
   hashsize=sizeof(hashtype);
   halfhashsize=hashsize div 2;
   hashdwords=hashsize div wordsize;
diff --git a/lcoretest.dpr b/lcoretest.dpr
index b84b8ec..3c4277d 100755
--- a/lcoretest.dpr
+++ b/lcoretest.dpr
@@ -11,11 +11,15 @@ uses
   dnsasync,
   binipstuff,
   sysutils,
-  dnssync,
+  dnssync
   //we don't actually make any use of the units below in this app, we just
   //include it to check if it compiles ok ;)
-  lmessages,
-  unitfork;
+  {$ifndef win32}
+    ,
+    lmessages,
+    unitfork
+  {$endif}
+  ;
 {$ifdef win32}
   {$R *.RES}
 {$endif}
@@ -36,6 +40,7 @@ var
   clientsocket : tlsocket;
   sc : tsc;
   task : tltask;
+  firststage : boolean;
 procedure tsc.sessionavailable(sender: tobject;error : word);
 begin
   writeln('received connection');
@@ -86,11 +91,11 @@ end;
 
 procedure tsc.sessionconnected(sender: tobject;error : word);
 begin
-  
+
   if error=0 then begin
     writeln('session is connected, local address is'+clientsocket.getxaddr);
 
-    if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin
+    if firststage then begin
       clientsocket.sendstr('hello world');
     end else begin
       clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);
@@ -112,12 +117,12 @@ begin
   writeln('closing client socket');
   clientsocket.close;
 
-  writeln('looking up irc.ipv6.p10link.net using dnsasync');
+  writeln('looking up irc.p10link.net using dnsasync');
   das := tdnsasync.Create(nil);
   das.onrequestdone := sc.dnsrequestdone;
   //das.forwardfamily := af_inet6;
-  das.forwardlookup('irc.ipv6.p10link.net');
-  
+  das.forwardlookup('irc.p10link.net');
+
 end;
 
 procedure tsc.dnsrequestdone(sender:tobject;error : word);
@@ -125,12 +130,13 @@ var
   tempbinip : tbinip;
   tempbiniplist : tbiniplist;
 begin
-  writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');
+  writeln('irc.p10link.net resolved to '+das.dnsresult+' connecting client socket there');
   das.dnsresultbin(tempbinip);
   tempbiniplist := biniplist_new;
   biniplist_add(tempbiniplist,tempbinip);
   clientsocket.addr := tempbiniplist;
   clientsocket.port := '6667';
+  firststage := false;
   clientsocket.connect;
   //writeln(clientsocket.getxaddr);
   das.free;
@@ -148,7 +154,9 @@ var
   timer : tltimer;
   ipbin : tbinip;
   dummy : integer;
+  iplist : tbiniplist;
 begin
+  lcoreinit;
   ipbin := forwardlookup('invalid.domain',5);
   writeln(ipbintostr(ipbin));
 
@@ -162,7 +170,7 @@ begin
   writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));
   writeln('creating and setting up listen socket');
   listensocket := tlsocket.create(nil);
-  listensocket.addr := '::';
+  listensocket.addr := '';
   listensocket.port := '12345';
   listensocket.onsessionavailable := sc.sessionavailable;
   writeln('listening');
@@ -174,12 +182,19 @@ begin
   serversocket.ondataavailable := sc.dataavailable;
   writeln('creating and setting up client socket');
   clientsocket := tlsocket.create(nil);
-  clientsocket.addr := '::1';{'127.0.0.1';}
+  //try connecting to ::1 first and if that fails try 127.0.0.1
+  iplist := biniplist_new;
+  ipstrtobin('::1',ipbin);
+  biniplist_add(iplist,ipbin);
+  ipstrtobin('127.0.0.1',ipbin);
+  biniplist_add(iplist,ipbin);
+  clientsocket.addr := iplist;
   clientsocket.port := '12345';
   clientsocket.onsessionconnected := sc.sessionconnected;
   clientsocket.ondataAvailable := sc.dataavailable;
   clientsocket.onsessionclosed := sc.sessionclosed;
   writeln('connecting');
+  firststage := true;
   clientsocket.connect;
   writeln('client socket is number ',clientsocket.fdhandlein);
   writeln('creating and setting up timer');
diff --git a/lmessages.pas b/lmessages.pas
index 0dc159b..1302e29 100755
--- a/lmessages.pas
+++ b/lmessages.pas
@@ -3,6 +3,11 @@
   which is included in the package
   ----------------------------------------------------------------------------- }
 
+//this unit provides a rough approximation of windows messages on linux
+//it is usefull for multithreaded applications on linux to communicate back to
+//the main lcore thread
+//This unit is *nix only, on windows you should use the real thing
+
 unit lmessages;
 //windows messages like system based on lcore tasks
 interface
diff --git a/lsocket.pas b/lsocket.pas
index 1dff390..18e7658 100755
--- a/lsocket.pas
+++ b/lsocket.pas
@@ -107,9 +107,6 @@ type
       procedure secondaccepthandler(sender:tobject;error:word);
       procedure internalclose(error:word);override;
       {$endif}
-      procedure connectionfailedhandler(error:word);
-      procedure connecttimeouthandler(sender:tobject);
-      procedure connectsuccesshandler;
       function getaddrsize:integer;
       procedure connect; virtual;
       procedure realconnect;
@@ -131,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;
@@ -160,7 +165,7 @@ procedure tlsocket.realconnect;
 var
   a,b:integer;
 begin
-//  writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);
+  //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;
@@ -171,21 +176,30 @@ begin
     a := SOCK_DGRAM;
     udp := true;
     dgram := true;
-  end else if (uppercase(proto) = 'TCP') then begin
+  end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin
     b := IPPROTO_TCP;
     a := SOCK_STREAM;
     dgram := false;
-  end else begin
+  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;
+  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);
@@ -359,7 +373,7 @@ begin
   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
@@ -379,7 +393,7 @@ 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 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
@@ -525,6 +539,11 @@ begin
   srclen := tempsrclen;
 end;
 
+procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);
+begin
+  connectionfailedhandler(wparam);
+end;
+
 procedure tlsocket.connectionfailedhandler(error:word);
 begin
    if trymoreips then begin
-- 
2.30.2