move ipv6 connectivity check from dnscore init to a reusable function in lcorelocalips
[lcore.git] / lcore.pas
index c936b59d7d8376f990d3e54a8268d3cc20352b1c..08c242a8e2a4b8bcb41d3558ca5eb4627a56e2c9 100644 (file)
--- a/lcore.pas
+++ b/lcore.pas
@@ -45,7 +45,7 @@ interface
     receivebufsize=packetbasesize*8;\r
 \r
   var\r
     receivebufsize=packetbasesize*8;\r
 \r
   var\r
-    absoloutemaxs:integer=0;\r
+    absolutemaxs:integer=0;\r
 \r
   type\r
     {$ifdef ver1_0}\r
 \r
   type\r
     {$ifdef ver1_0}\r
@@ -84,8 +84,8 @@ interface
     public\r
       state              : tsocketstate      ;\r
       ComponentOptions   : TWSocketOptions;\r
     public\r
       state              : tsocketstate      ;\r
       ComponentOptions   : TWSocketOptions;\r
-      fdhandlein         : Longint           ;  {file discriptor}\r
-      fdhandleout        : Longint           ;  {file discriptor}\r
+      fdhandlein         : Longint           ;  {file descriptor}\r
+      fdhandleout        : Longint           ;  {file descriptor}\r
 \r
       onsessionclosed    : tsocketevent      ;\r
       ondataAvailable    : tsocketevent      ;\r
 \r
       onsessionclosed    : tsocketevent      ;\r
       ondataAvailable    : tsocketevent      ;\r
@@ -106,6 +106,10 @@ interface
       lasterror:integer;\r
       destroying:boolean;\r
       recvbufsize:integer;\r
       lasterror:integer;\r
       destroying:boolean;\r
       recvbufsize:integer;\r
+      datasentcalled:boolean;\r
+      {$ifdef mswindows}\r
+      sendflushlasterror:integer;\r
+      {$endif}\r
       function receivestr:tbufferstring; virtual;\r
       procedure close;\r
       procedure abort;\r
       function receivestr:tbufferstring; virtual;\r
       procedure close;\r
       procedure abort;\r
@@ -164,7 +168,7 @@ interface
 //      finitialevent       : boolean           ;\r
       fontimer            : tnotifyevent      ;\r
       fenabled            : boolean           ;\r
 //      finitialevent       : boolean           ;\r
       fontimer            : tnotifyevent      ;\r
       fenabled            : boolean           ;\r
-      finterval                  : integer          ; {miliseconds, default 1000}\r
+      finterval                  : integer          ; {milliseconds, default 1000}\r
       {$ifndef mswindows}\r
         procedure resettimes;\r
       {$endif}\r
       {$ifndef mswindows}\r
         procedure resettimes;\r
       {$endif}\r
@@ -173,7 +177,7 @@ interface
       procedure setenabled(newvalue : boolean);\r
       procedure setinterval(newvalue : integer);\r
     public\r
       procedure setenabled(newvalue : boolean);\r
       procedure setinterval(newvalue : integer);\r
     public\r
-      //making theese public for now, this code should probablly be restructured later though\r
+      //making these public for now, this code should probably be restructured later though\r
       prevtimer          : tltimer           ;\r
       nexttimer          : tltimer           ;\r
       nextts            : ttimeval          ;\r
       prevtimer          : tltimer           ;\r
       nexttimer          : tltimer           ;\r
       nextts            : ttimeval          ;\r
@@ -221,7 +225,7 @@ procedure exitmessageloop;
 \r
 var\r
   firsttimer                            : tltimer    ;\r
 \r
 var\r
   firsttimer                            : tltimer    ;\r
-  firsttask  , lasttask   , currenttask : tltask     ;\r
+  firsttask  , lasttask                 : tltask     ;\r
 \r
   numread                               : integer    ;\r
   mustrefreshfds                        : boolean    ;\r
 \r
   numread                               : integer    ;\r
   mustrefreshfds                        : boolean    ;\r
@@ -484,12 +488,17 @@ begin
     result := -1;\r
     exit;\r
   end;\r
     result := -1;\r
     exit;\r
   end;\r
+  datasentcalled := false;\r
 \r
   lensent := sendq.get(data,packetbasesize*2);\r
   if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;\r
 \r
   if result = -1 then lensent := 0 else lensent := result;\r
 \r
 \r
   lensent := sendq.get(data,packetbasesize*2);\r
   if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;\r
 \r
   if result = -1 then lensent := 0 else lensent := result;\r
 \r
+  {$ifdef mswindows}\r
+  if (result = -1) then sendflushlasterror := getlasterror else sendflushlasterror := 0;\r
+  {$endif}\r
+\r
   //sendq := copy(sendq,lensent+1,length(sendq)-lensent);\r
   sendq.del(lensent);\r
 \r
   //sendq := copy(sendq,lensent+1,length(sendq)-lensent);\r
   sendq.del(lensent);\r
 \r
@@ -562,14 +571,14 @@ begin
 \r
         end else begin\r
           {$ifdef mswindows}\r
 \r
         end else begin\r
           {$ifdef mswindows}\r
-          if getlasterror=WSAEWOULDBLOCK then begin\r
+          if sendflushlasterror=WSAEWOULDBLOCK then begin\r
             //the asynchronous nature of windows messages means we sometimes\r
             //get here with the buffer full\r
             //so do nothing in that case\r
           end else\r
           {$endif}\r
           begin\r
             //the asynchronous nature of windows messages means we sometimes\r
             //get here with the buffer full\r
             //so do nothing in that case\r
           end else\r
           {$endif}\r
           begin\r
-            internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif});\r
+            internalclose({$ifdef mswindows}sendflushlasterror{$else}linuxerror{$endif});\r
           end  \r
         end;\r
       end;\r
           end  \r
         end;\r
       end;\r
@@ -577,7 +586,13 @@ begin
     end else begin\r
       //everything is sent fire off ondatasent event\r
       if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
     end else begin\r
       //everything is sent fire off ondatasent event\r
       if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);\r
-      if assigned(ondatasent) then tltask.create(self.dodatasent,self,0,0);\r
+      if assigned(ondatasent) then begin\r
+        if not datasentcalled then begin\r
+          tltask.create(self.dodatasent,self,0,0);\r
+          datasentcalled := true;\r
+        end;\r
+      end;\r
+\r
     end;\r
     if assigned(onfdwrite) then onfdwrite(self,0);\r
   end;\r
     end;\r
     if assigned(onfdwrite) then onfdwrite(self,0);\r
   end;\r
@@ -590,7 +605,7 @@ begin
       if (numread=0) and (not mustrefreshfds) then begin\r
         {if i remember correctly numread=0 is caused by eof\r
         if this isn't dealt with then you get a cpu eating infinite loop\r
       if (numread=0) and (not mustrefreshfds) then begin\r
         {if i remember correctly numread=0 is caused by eof\r
         if this isn't dealt with then you get a cpu eating infinite loop\r
-        however if onsessionconencted has called processmessages that could\r
+        however if onsessionconnected has called processmessages that could\r
         cause us to drop to here with an empty recvq and nothing left to read\r
         and we don't want that to cause the socket to close}\r
 \r
         cause us to drop to here with an empty recvq and nothing left to read\r
         and we don't want that to cause the socket to close}\r
 \r
@@ -654,7 +669,7 @@ end;
 {$ifndef mswindows}\r
   procedure tltimer.resettimes;\r
   begin\r
 {$ifndef mswindows}\r
   procedure tltimer.resettimes;\r
   begin\r
-    gettimeofday(nextts);\r
+    gettimemonotonic(nextts);\r
     {if not initialevent then} tv_add(nextts,interval);\r
   end;\r
 {$endif}\r
     {if not initialevent then} tv_add(nextts,interval);\r
   end;\r
 {$endif}\r
@@ -798,26 +813,18 @@ end;
 \r
 procedure processtasks;//inline;\r
 var\r
 \r
 procedure processtasks;//inline;\r
 var\r
-  temptask                : tltask   ;\r
-\r
+  currenttask:tltask;\r
 begin\r
 \r
 begin\r
 \r
-  if not assigned(currenttask) then begin\r
+  while assigned(firsttask) do begin\r
     currenttask := firsttask;\r
     currenttask := firsttask;\r
-    firsttask := nil;\r
-    lasttask  := nil;\r
-  end;\r
-  while assigned(currenttask) do begin\r
+    firsttask := firsttask.nexttask;\r
+    if not assigned(firsttask) then lasttask := nil;\r
 \r
     if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);\r
 \r
     if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);\r
-    if assigned(currenttask) then begin\r
-      temptask := currenttask;\r
-      currenttask := currenttask.nexttask;\r
-      temptask.free;\r
-    end;\r
-    //writeln('processed a task');\r
+    currenttask.free;\r
   end;\r
   end;\r
-\r
+  currenttask := nil;\r
 end;\r
 \r
 \r
 end;\r
 \r
 \r
@@ -826,23 +833,18 @@ end;
 procedure disconnecttasks(aobj:tobject);\r
 var\r
   currenttasklocal : tltask ;\r
 procedure disconnecttasks(aobj:tobject);\r
 var\r
   currenttasklocal : tltask ;\r
-  counter          : byte   ;\r
+\r
 begin\r
 begin\r
-  for counter := 0 to 1 do begin\r
-    if counter = 0 then begin\r
-      currenttasklocal := firsttask; //main list of tasks\r
-    end else begin\r
-      currenttasklocal := currenttask; //needed in case called from a task\r
-    end;\r
-    // note i don't bother to sestroy the links here as that will happen when\r
-    // the list of tasks is processed anyway\r
-    while assigned(currenttasklocal) do begin\r
-      if currenttasklocal.obj = aobj then begin\r
-        currenttasklocal.obj := nil;\r
-        currenttasklocal.handler := nil;\r
-      end;\r
-      currenttasklocal := currenttasklocal.nexttask;\r
+  currenttasklocal := firsttask; //main list of tasks\r
+\r
+  // note i don't bother to destroy the links here as that will happen when\r
+  // the list of tasks is processed anyway\r
+  while assigned(currenttasklocal) do begin\r
+    if currenttasklocal.obj = aobj then begin\r
+      currenttasklocal.obj := nil;\r
+      currenttasklocal.handler := nil;\r
     end;\r
     end;\r
+    currenttasklocal := currenttasklocal.nexttask;\r
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r