Branch for Delphi 2009/2010 port

[lcore.git] / lcore.pas

diff --git a/lcore.pas b/lcore.pas
index 30e9c09dc9d77e5f20f1f6fa8883a82fafff4051..bb9eb8d606537ee4a8caf0fbd300105515e363c8 100755 (executable)
--- a/lcore.pas
+++ b/lcore.pas
@@ -26,16 +26,23 @@ interface
       {$ifdef VER1_0}\r
         linux,\r
       {$else}\r
       {$ifdef VER1_0}\r
         linux,\r
       {$else}\r

-        baseunix,unix,unixutil,\r
+        baseunix,unix,unixutil,sockets,\r

       {$endif}\r
       fd_utils,\r
     {$endif}\r
       {$endif}\r
       fd_utils,\r
     {$endif}\r

-    classes,pgtypes,bfifo;\r
+    classes,pgtypes,bfifo,ltimevalstuff;\r

   procedure processtasks;\r
 \r
 \r
   const\r
   procedure processtasks;\r
 \r
 \r
   const\r

-    receivebufsize=1460;\r
+    {how this number is made up:\r
+    - ethernet: MTU 1500\r
+    - be safe for either "ethernet v1" or "PPPoE", both take 8 bytes\r
+    - IPv6 header: 40 bytes (IPv4 is 20)\r
+    - TCP/UDP header: 20 bytes\r
+    }\r
+    packetbasesize = 1432;\r
+    receivebufsize=packetbasesize*8;\r

 \r
   var\r
     absoloutemaxs:integer=0;\r
 \r
   var\r
     absoloutemaxs:integer=0;\r


@@ -66,8 +73,9 @@ interface
     TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;\r
 \r
     tlcomponent = class(tcomponent)\r
     TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;\r
 \r
     tlcomponent = class(tcomponent)\r

+    private\r
+      procedure releasetaskhandler(wparam,lparam:longint);\r

     public\r
     public\r

-      released:boolean;\r

       procedure release; virtual;\r
       destructor destroy; override;\r
     end;\r
       procedure release; virtual;\r
       destructor destroy; override;\r
     end;\r


@@ -87,8 +95,6 @@ interface
       onsenddata         : tsenddata      ;\r
       ondatasent         : tsocketevent      ;\r
       //connected          : boolean         ;\r
       onsenddata         : tsenddata      ;\r
       ondatasent         : tsocketevent      ;\r
       //connected          : boolean         ;\r

-      nextasin           : tlasio            ;\r
-      prevasin           : tlasio            ;\r

 \r
       recvq              : tfifo;\r
       OnBgException      : TBgExceptionEvent ;\r
 \r
       recvq              : tfifo;\r
       OnBgException      : TBgExceptionEvent ;\r


@@ -99,6 +105,7 @@ interface
       onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd\r
       lasterror:integer;\r
       destroying:boolean;\r
       onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd\r
       lasterror:integer;\r
       destroying:boolean;\r

+      recvbufsize:integer;\r

       function receivestr:string; virtual;\r
       procedure close;\r
       procedure abort;\r
       function receivestr:string; virtual;\r
       procedure close;\r
       procedure abort;\r


@@ -120,7 +127,7 @@ interface
 \r
       //procedure messageloop;\r
       function Receive(Buf:Pointer;BufSize:integer):integer; virtual;\r
 \r
       //procedure messageloop;\r
       function Receive(Buf:Pointer;BufSize:integer):integer; virtual;\r

-      procedure flush;virtual;{$ifdef win32} abstract;{$endif}\r
+      procedure flush;virtual;\r

       procedure dodatasent(wparam,lparam:longint);\r
       procedure doreceiveloop(wparam,lparam:longint);\r
       procedure sinkdata(sender:tobject;error:word);\r
       procedure dodatasent(wparam,lparam:longint);\r
       procedure doreceiveloop(wparam,lparam:longint);\r
       procedure sinkdata(sender:tobject;error:word);\r


@@ -147,12 +154,6 @@ interface
   var\r
     timerwrapperinterface : ttimerwrapperinterface;\r
   type\r
   var\r
     timerwrapperinterface : ttimerwrapperinterface;\r
   type\r

-    {$ifdef win32}\r
-      ttimeval = record\r
-        tv_sec : longint;\r
-        tv_usec : longint;\r
-      end;\r
-    {$endif}\r

     tltimer=class(tlcomponent)\r
     protected\r
 \r
     tltimer=class(tlcomponent)\r
     protected\r
 \r


@@ -219,7 +220,6 @@ procedure messageloop;
 procedure exitmessageloop;\r
 \r
 var\r
 procedure exitmessageloop;\r
 \r
 var\r

-  firstasin                             : tlasio     ;\r

   firsttimer                            : tltimer    ;\r
   firsttask  , lasttask   , currenttask : tltask     ;\r
 \r
   firsttimer                            : tltimer    ;\r
   firsttask  , lasttask   , currenttask : tltask     ;\r
 \r


@@ -254,7 +254,6 @@ implementation
 {$ifndef win32}\r
   {$include unixstuff.inc}\r
 {$endif}\r
 {$ifndef win32}\r
   {$include unixstuff.inc}\r
 {$endif}\r

-{$include ltimevalstuff.inc}\r

 \r
 \r
 {!!! added sleep call -beware}\r
 \r
 \r
 {!!! added sleep call -beware}\r


@@ -277,12 +276,15 @@ begin
   inherited destroy;\r
 end;\r
 \r
   inherited destroy;\r
 end;\r
 \r

-\r
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);\r
+begin\r
+  free;\r
+end;\r

 \r
 \r
 procedure tlcomponent.release;\r
 begin\r
 \r
 \r
 procedure tlcomponent.release;\r
 begin\r

-  released := true;\r
+  addtask(releasetaskhandler,self,0,0);\r

 end;\r
 \r
 procedure tlasio.release;\r
 end;\r
 \r
 procedure tlasio.release;\r


@@ -335,26 +337,12 @@ begin
   state := wsclosed;\r
   fdhandlein := -1;\r
   fdhandleout := -1;\r
   state := wsclosed;\r
   fdhandlein := -1;\r
   fdhandleout := -1;\r

-  nextasin := firstasin;\r
-  prevasin := nil;\r
-  if assigned(nextasin) then nextasin.prevasin := self;\r
-  firstasin := self;\r
-\r
-  released := false;\r

 end;\r
 \r
 destructor tlasio.destroy;\r
 begin\r
   destroying := true;\r
   if state <> wsclosed then close;\r
 end;\r
 \r
 destructor tlasio.destroy;\r
 begin\r
   destroying := true;\r
   if state <> wsclosed then close;\r

-  if prevasin <> nil then begin\r
-    prevasin.nextasin := nextasin;\r
-  end else begin\r
-    firstasin := nextasin;\r
-  end;\r
-  if nextasin <> nil then begin\r
-    nextasin.prevasin := prevasin;\r
-  end;\r

   recvq.free;\r
   sendq.free;\r
   inherited destroy;\r
   recvq.free;\r
   sendq.free;\r
   inherited destroy;\r


@@ -397,6 +385,9 @@ end;
 procedure tlasio.internalclose(error:word);\r
 begin\r
   if (state<>wsclosed) and (state<>wsinvalidstate) then begin\r
 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
     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


@@ -487,9 +478,12 @@ var
 //  fdstestr : fdset;\r
 //  fdstestw : fdset;\r
 begin\r
 //  fdstestr : fdset;\r
 //  fdstestw : fdset;\r
 begin\r

-  if state <> wsconnected then exit;\r
+  if state <> wsconnected then begin\r
+    result := -1;\r
+    exit;\r
+  end;\r

 \r
 \r

-  lensent := sendq.get(data,2920);\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
   if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;\r
 \r
   if result = -1 then lensent := 0 else lensent := result;\r


@@ -552,6 +546,7 @@ procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
 var\r
   sendflushresult : integer;\r
   tempbuf:array[0..receivebufsize-1] of byte;\r
 var\r
   sendflushresult : integer;\r
   tempbuf:array[0..receivebufsize-1] of byte;\r

+  a:integer;\r

 begin\r
   if (state=wsconnected) and writetrigger then begin\r
     //writeln('write trigger');\r
 begin\r
   if (state=wsconnected) and writetrigger then begin\r
     //writeln('write trigger');\r


@@ -564,7 +559,16 @@ begin
           internalclose(0);\r
 \r
         end else begin\r
           internalclose(0);\r
 \r
         end else begin\r

-          internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
+          {$ifdef win32}\r
+          if getlasterror=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
+            internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
+          end  \r

         end;\r
       end;\r
 \r
         end;\r
       end;\r
 \r


@@ -578,7 +582,9 @@ begin
   writtenthiscycle := false;\r
   if (state =wsconnected) and readtrigger then begin\r
     if recvq.size=0 then begin\r
   writtenthiscycle := false;\r
   if (state =wsconnected) and readtrigger then begin\r
     if recvq.size=0 then begin\r

-      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));\r
+      a := recvbufsize;\r
+      if (a <= 0) or (a > sizeof(tempbuf)) then a := sizeof(tempbuf);\r
+      numread := myfdread(fdhandlein,tempbuf,a);\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
       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


@@ -613,19 +619,20 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-{$ifndef win32}\r
-  procedure tlasio.flush;\r
-  var\r
-    fds : fdset;\r
-  begin\r
-    fd_zero(fds);\r
-    fd_set(fdhandleout,fds);\r
-    while sendq.size>0 do begin\r
-      select(fdhandleout+1,nil,@fds,nil,nil);\r
-      if sendflush <= 0 then exit;\r
-    end;\r
-  end;\r
+procedure tlasio.flush;\r
+{$ifdef win32}\r
+type fdset = tfdset;\r

 {$endif}\r
 {$endif}\r

+var\r
+  fds : fdset;\r
+begin\r
+  fd_zero(fds);\r
+  fd_set(fdhandleout,fds);\r
+  while sendq.size>0 do begin\r
+    select(fdhandleout+1,nil,@fds,nil,nil);\r
+    if sendflush <= 0 then exit;\r
+  end;\r
+end;\r

 \r
 procedure tlasio.dodatasent(wparam,lparam:longint);\r
 begin\r
 \r
 procedure tlasio.dodatasent(wparam,lparam:longint);\r
 begin\r


@@ -728,8 +735,6 @@ begin
   end;\r
   interval := 1000;\r
   enabled := true;\r
   end;\r
   interval := 1000;\r
   enabled := true;\r

-  released := false;\r
-\r

 end;\r
 \r
 destructor tltimer.destroy;\r
 end;\r
 \r
 destructor tltimer.destroy;\r


@@ -880,7 +885,6 @@ end;
 \r
 \r
 begin\r
 \r
 \r
 begin\r

-  firstasin := nil;\r

   firsttask := nil;\r
   \r
 \r
   firsttask := nil;\r
   \r
 \r