* various fixups resulting from getting the test app working on a XP
authorplugwash <plugwash@p10link.net>
Sat, 31 Jan 2009 00:58:54 +0000 (00:58 +0000)
committerplugwash <plugwash@p10link.net>
Sat, 31 Jan 2009 00:58:54 +0000 (00:58 +0000)
  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
lcorernd.pas
lcoretest.dpr
lmessages.pas
lsocket.pas

index 7db6b3ef2e5e50b5a54043ee0989a3fe7b10eace..727ca1cf16e76b0931eb6540116d33c7522f3113 100755 (executable)
--- a/lcore.pas
+++ b/lcore.pas
@@ -405,6 +405,9 @@ end;
 procedure tlasio.internalclose(error:word);\r
 begin\r
   if (state<>wsclosed) and (state<>wsinvalidstate) then begin\r
+    // -2 is a special indication that we should just exist silently\r
+    // (used for connect failure handling when socket creation fails)\r
+    if (fdhandlein = -2) and (fdhandleout = -2) then exit;\r
     if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');\r
     eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);\r
     eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
index 006f6ce885e1de1298b459af0574a138a4481736..643de3ad3a74848409756e0f33590b02da53699c 100644 (file)
@@ -132,7 +132,7 @@ implementation
 \r
 {$ifndef nolcorernd}\r
 uses\r
-  {$ifdef win32}windows,activex,types,{$endif}\r
+  {$ifdef win32}windows,activex,{$endif}\r
   {$ifdef unix}baseunix,unix,unixutil,{$endif}\r
   fastmd5,sysutils;\r
 \r
@@ -145,9 +145,8 @@ type
 const\r
   wordsizeshift=2;\r
   wordsize=1 shl wordsizeshift;\r
-\r
-  {$if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{$ifend}\r
-\r
+  //wordsize check commented out for d3 compatibility\r
+  //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}\r
   hashsize=sizeof(hashtype);\r
   halfhashsize=hashsize div 2;\r
   hashdwords=hashsize div wordsize;\r
index b84b8ec1b3668d7dd848efec61804f588c25d8d0..3c4277d2cc062b19a1e8ebe503692270a2ce0f86 100755 (executable)
@@ -11,11 +11,15 @@ uses
   dnsasync,\r
   binipstuff,\r
   sysutils,\r
-  dnssync,\r
+  dnssync\r
   //we don't actually make any use of the units below in this app, we just\r
   //include it to check if it compiles ok ;)\r
-  lmessages,\r
-  unitfork;\r
+  {$ifndef win32}\r
+    ,\r
+    lmessages,\r
+    unitfork\r
+  {$endif}\r
+  ;\r
 {$ifdef win32}\r
   {$R *.RES}\r
 {$endif}\r
@@ -36,6 +40,7 @@ var
   clientsocket : tlsocket;\r
   sc : tsc;\r
   task : tltask;\r
+  firststage : boolean;\r
 procedure tsc.sessionavailable(sender: tobject;error : word);\r
 begin\r
   writeln('received connection');\r
@@ -86,11 +91,11 @@ end;
 \r
 procedure tsc.sessionconnected(sender: tobject;error : word);\r
 begin\r
-  \r
+\r
   if error=0 then begin\r
     writeln('session is connected, local address is'+clientsocket.getxaddr);\r
 \r
-    if (clientsocket.addr = '127.0.0.1') or (clientsocket.addr = '::1') then begin\r
+    if firststage then begin\r
       clientsocket.sendstr('hello world');\r
     end else begin\r
       clientsocket.sendstr('nick test'#13#10'user x x x x'#13#10);\r
@@ -112,12 +117,12 @@ begin
   writeln('closing client socket');\r
   clientsocket.close;\r
 \r
-  writeln('looking up irc.ipv6.p10link.net using dnsasync');\r
+  writeln('looking up irc.p10link.net using dnsasync');\r
   das := tdnsasync.Create(nil);\r
   das.onrequestdone := sc.dnsrequestdone;\r
   //das.forwardfamily := af_inet6;\r
-  das.forwardlookup('irc.ipv6.p10link.net');\r
-  \r
+  das.forwardlookup('irc.p10link.net');\r
+\r
 end;\r
 \r
 procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
@@ -125,12 +130,13 @@ var
   tempbinip : tbinip;\r
   tempbiniplist : tbiniplist;\r
 begin\r
-  writeln('irc.ipv6.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
+  writeln('irc.p10link.net resolved to '+das.dnsresult+' connecting client socket there');\r
   das.dnsresultbin(tempbinip);\r
   tempbiniplist := biniplist_new;\r
   biniplist_add(tempbiniplist,tempbinip);\r
   clientsocket.addr := tempbiniplist;\r
   clientsocket.port := '6667';\r
+  firststage := false;\r
   clientsocket.connect;\r
   //writeln(clientsocket.getxaddr);\r
   das.free;\r
@@ -148,7 +154,9 @@ var
   timer : tltimer;\r
   ipbin : tbinip;\r
   dummy : integer;\r
+  iplist : tbiniplist;\r
 begin\r
+  lcoreinit;\r
   ipbin := forwardlookup('invalid.domain',5);\r
   writeln(ipbintostr(ipbin));\r
 \r
@@ -162,7 +170,7 @@ begin
   writeln('2001:200::8002:203:47ff:fea5:3085 reverses to '+reverselookup(ipbin,5));\r
   writeln('creating and setting up listen socket');\r
   listensocket := tlsocket.create(nil);\r
-  listensocket.addr := '::';\r
+  listensocket.addr := '';\r
   listensocket.port := '12345';\r
   listensocket.onsessionavailable := sc.sessionavailable;\r
   writeln('listening');\r
@@ -174,12 +182,19 @@ begin
   serversocket.ondataavailable := sc.dataavailable;\r
   writeln('creating and setting up client socket');\r
   clientsocket := tlsocket.create(nil);\r
-  clientsocket.addr := '::1';{'127.0.0.1';}\r
+  //try connecting to ::1 first and if that fails try 127.0.0.1\r
+  iplist := biniplist_new;\r
+  ipstrtobin('::1',ipbin);\r
+  biniplist_add(iplist,ipbin);\r
+  ipstrtobin('127.0.0.1',ipbin);\r
+  biniplist_add(iplist,ipbin);\r
+  clientsocket.addr := iplist;\r
   clientsocket.port := '12345';\r
   clientsocket.onsessionconnected := sc.sessionconnected;\r
   clientsocket.ondataAvailable := sc.dataavailable;\r
   clientsocket.onsessionclosed := sc.sessionclosed;\r
   writeln('connecting');\r
+  firststage := true;\r
   clientsocket.connect;\r
   writeln('client socket is number ',clientsocket.fdhandlein);\r
   writeln('creating and setting up timer');\r
index 0dc159b4c8841a9de5b27d80e9c0dd48401d7233..1302e298afb5f3a5ed649bdc9f8a6f4f91ba8215 100755 (executable)
@@ -3,6 +3,11 @@
   which is included in the package\r
   ----------------------------------------------------------------------------- }\r
 \r
+//this unit provides a rough approximation of windows messages on linux\r
+//it is usefull for multithreaded applications on linux to communicate back to\r
+//the main lcore thread\r
+//This unit is *nix only, on windows you should use the real thing\r
+\r
 unit lmessages;\r
 //windows messages like system based on lcore tasks\r
 interface\r
index 1dff390319609fdf9ce6bca435c7ddd02bd706d2..18e7658c3c90d44a4a385046f307cf393104c417 100755 (executable)
@@ -107,9 +107,6 @@ type
       procedure secondaccepthandler(sender:tobject;error:word);\r
       procedure internalclose(error:word);override;\r
       {$endif}\r
-      procedure connectionfailedhandler(error:word);\r
-      procedure connecttimeouthandler(sender:tobject);\r
-      procedure connectsuccesshandler;\r
       function getaddrsize:integer;\r
       procedure connect; virtual;\r
       procedure realconnect;\r
@@ -131,6 +128,14 @@ type
       function getXport:string; virtual;\r
       function getpeerport:string; virtual;\r
       constructor Create(AOwner: TComponent); override;\r
+\r
+      //this one has to be kept public for now because lcorewsaasyncselect calls it\r
+      procedure connectionfailedhandler(error:word);\r
+    private\r
+      procedure taskcallconnectionfailedhandler(wparam,lparam : longint);\r
+\r
+      procedure connecttimeouthandler(sender:tobject);\r
+      procedure connectsuccesshandler;\r
       {$ifdef win32}\r
         procedure myfdclose(fd : integer); override;\r
         function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override;\r
@@ -160,7 +165,7 @@ procedure tlsocket.realconnect;
 var\r
   a,b:integer;\r
 begin\r
-//  writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);\r
+  //writeln('trying to connect to ',ipbintostr(biniplist_get(biniplist,currentip)),'#',port);\r
   makeinaddrv(biniplist_get(biniplist,currentip),port,inaddr);\r
   inc(currentip);\r
   if (currentip >= biniplist_getcount(biniplist)) then trymoreips := false;\r
@@ -171,21 +176,30 @@ begin
     a := SOCK_DGRAM;\r
     udp := true;\r
     dgram := true;\r
-  end else if (uppercase(proto) = 'TCP') then begin\r
+  end else if (uppercase(proto) = 'TCP') or (uppercase(proto) = '') then begin\r
     b := IPPROTO_TCP;\r
     a := SOCK_STREAM;\r
     dgram := false;\r
-  end else begin\r
+  end else if (uppercase(proto) = 'ICMP') or (strtointdef(proto,256) < 256) then begin\r
+    //note: ICMP support doesn't seem to work yet\r
     b := strtointdef(proto,IPPROTO_ICMP);\r
     a := SOCK_RAW;\r
     dgram := true;\r
+  end else begin\r
+    raise ESocketException.create('unrecognised protocol');\r
   end;\r
 \r
   a := Socket(inaddr.inaddr.family,a,b);\r
   //writeln(ord(inaddr.inaddr.family));\r
   if a = -1 then begin\r
-    lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};\r
-    raise esocketexception.create('unable to create socket');\r
+    //unable to create socket, fire an error event (better to use an error event\r
+    //to avoid poor interaction with multilistener stuff.\r
+    //a socket value of -2 is a special value to say there is no socket but\r
+    //we want internalclose to act as if there was\r
+    fdhandlein := -2;\r
+    fdhandleout := -2;\r
+    tltask.create(taskcallconnectionfailedhandler,self,{$ifdef win32}wsagetlasterror{$else}socketerror{$endif},0);\r
+    exit;\r
   end;\r
   try\r
     dup(a);\r
@@ -359,7 +373,7 @@ begin
   end;\r
   {$endif}\r
 \r
-  if fdhandlein = -1 then raise ESocketException.create('unable to create socket');\r
+  if fdhandlein = -1 then raise ESocketException.create('unable to create socket'{$ifdef win32}+' error='+inttostr(wsagetlasterror){$endif});\r
   dupnowatch(fdhandlein); // sets up maxs and copies handle to fdhandleout among other things\r
   //eventcore.setfdreverse(fdhandlein,self); //already taken care of by dup\r
   state := wsclosed; // then set this back as it was an undesired side effect of dup\r
@@ -379,7 +393,7 @@ begin
     if not udp then begin\r
       {!!! allow custom queue length? default 5}\r
       if listenqueue = 0 then listenqueue := 5;\r
-      If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise \r
+      If {$ifdef win32}winsock{$else}sockets{$endif}.Listen(fdhandlein,listenqueue)<>{$ifdef win32}0{$else}true{$endif} Then raise\r
 esocketexception.create('unable to listen');\r
       state := wsListening;\r
     end else begin\r
@@ -525,6 +539,11 @@ begin
   srclen := tempsrclen;\r
 end;\r
 \r
+procedure tlsocket.taskcallconnectionfailedhandler(wparam,lparam : longint);\r
+begin\r
+  connectionfailedhandler(wparam);\r
+end;\r
+\r
 procedure tlsocket.connectionfailedhandler(error:word);\r
 begin\r
    if trymoreips then begin\r