X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..9e8179457b49de0ee52ab40192a88971fc3c01e6:/lcore.pas?ds=inline

diff --git a/lcore.pas b/lcore.pas
index 30e9c09..1a2f93c 100755
--- a/lcore.pas
+++ b/lcore.pas
@@ -26,16 +26,23 @@ interface
       {$ifdef VER1_0}
         linux,
       {$else}
-        baseunix,unix,unixutil,
+        baseunix,unix,unixutil,sockets,
       {$endif}
       fd_utils,
     {$endif}
-    classes,pgtypes,bfifo;
+    classes,pgtypes,bfifo,ltimevalstuff;
   procedure processtasks;
 
 
   const
-    receivebufsize=1460;
+    {how this number is made up:
+    - ethernet: MTU 1500
+    - be safe for either "ethernet v1" or "PPPoE", both take 8 bytes
+    - IPv6 header: 40 bytes (IPv4 is 20)
+    - TCP/UDP header: 20 bytes
+    }
+    packetbasesize = 1432;
+    receivebufsize=packetbasesize*8;
 
   var
     absoloutemaxs:integer=0;
@@ -66,8 +73,9 @@ interface
     TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;
 
     tlcomponent = class(tcomponent)
+    private
+      procedure releasetaskhandler(wparam,lparam:longint);
     public
-      released:boolean;
       procedure release; virtual;
       destructor destroy; override;
     end;
@@ -87,8 +95,6 @@ interface
       onsenddata         : tsenddata      ;
       ondatasent         : tsocketevent      ;
       //connected          : boolean         ;
-      nextasin           : tlasio            ;
-      prevasin           : tlasio            ;
 
       recvq              : tfifo;
       OnBgException      : TBgExceptionEvent ;
@@ -99,7 +105,8 @@ interface
       onfdwrite           : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd
       lasterror:integer;
       destroying:boolean;
-      function receivestr:string; virtual;
+      recvbufsize:integer;
+      function receivestr:tbufferstring; virtual;
       procedure close;
       procedure abort;
       procedure internalclose(error:word); virtual;
@@ -112,15 +119,15 @@ interface
       procedure dup(invalue:longint);
 
       function sendflush : integer;
-      procedure sendstr(const str : string);virtual;
-      procedure putstringinsendbuffer(const newstring : string);
+      procedure sendstr(const str : tbufferstring);virtual;
+      procedure putstringinsendbuffer(const newstring : tbufferstring);
       function send(data:pointer;len:integer):integer;virtual;
       procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
       procedure deletebuffereddata;
 
       //procedure messageloop;
       function Receive(Buf:Pointer;BufSize:integer):integer; virtual;
-      procedure flush;virtual;{$ifdef win32} abstract;{$endif}
+      procedure flush;virtual;
       procedure dodatasent(wparam,lparam:longint);
       procedure doreceiveloop(wparam,lparam:longint);
       procedure sinkdata(sender:tobject;error:word);
@@ -147,12 +154,6 @@ interface
   var
     timerwrapperinterface : ttimerwrapperinterface;
   type
-    {$ifdef win32}
-      ttimeval = record
-        tv_sec : longint;
-        tv_usec : longint;
-      end;
-    {$endif}
     tltimer=class(tlcomponent)
     protected
 
@@ -219,7 +220,6 @@ procedure messageloop;
 procedure exitmessageloop;
 
 var
-  firstasin                             : tlasio     ;
   firsttimer                            : tltimer    ;
   firsttask  , lasttask   , currenttask : tltask     ;
 
@@ -254,35 +254,39 @@ implementation
 {$ifndef win32}
   {$include unixstuff.inc}
 {$endif}
-{$include ltimevalstuff.inc}
 
 
 {!!! added sleep call -beware}
 procedure sleep(i:integer);
+{$ifdef win32}
+begin
+  windows.sleep(i);
+{$else}
 var
   tv:ttimeval;
 begin
-  {$ifdef win32}
-    windows.sleep(i);
-  {$else}
-    tv.tv_sec := i div 1000;
-    tv.tv_usec := (i mod 1000) * 1000;
-    select(0,nil,nil,nil,@tv);
-  {$endif}
+  tv.tv_sec := i div 1000;
+  tv.tv_usec := (i mod 1000) * 1000;
+  select(0,nil,nil,nil,@tv);
+{$endif}
 end;
 
+
 destructor tlcomponent.destroy;
 begin
   disconnecttasks(self);
   inherited destroy;
 end;
 
-
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
+begin
+  free;
+end;
 
 
 procedure tlcomponent.release;
 begin
-  released := true;
+  addtask(releasetaskhandler,self,0,0);
 end;
 
 procedure tlasio.release;
@@ -335,26 +339,12 @@ begin
   state := wsclosed;
   fdhandlein := -1;
   fdhandleout := -1;
-  nextasin := firstasin;
-  prevasin := nil;
-  if assigned(nextasin) then nextasin.prevasin := self;
-  firstasin := self;
-
-  released := false;
 end;
 
 destructor tlasio.destroy;
 begin
   destroying := true;
   if state <> wsclosed then close;
-  if prevasin <> nil then begin
-    prevasin.nextasin := nextasin;
-  end else begin
-    firstasin := nextasin;
-  end;
-  if nextasin <> nil then begin
-    nextasin.prevasin := prevasin;
-  end;
   recvq.free;
   sendq.free;
   inherited destroy;
@@ -397,6 +387,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);
@@ -451,13 +444,13 @@ begin
   end;
 end;
 
-procedure tlasio.sendstr(const str : string);
+procedure tlasio.sendstr(const str : tbufferstring);
 begin
   putstringinsendbuffer(str);
   sendflush;
 end;
 
-procedure tlasio.putstringinsendbuffer(const newstring : string);
+procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);
 begin
   if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
 end;
@@ -487,9 +480,12 @@ var
 //  fdstestr : fdset;
 //  fdstestw : fdset;
 begin
-  if state <> wsconnected then exit;
+  if state <> wsconnected then begin
+    result := -1;
+    exit;
+  end;
 
-  lensent := sendq.get(data,2920);
+  lensent := sendq.get(data,packetbasesize*2);
   if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
 
   if result = -1 then lensent := 0 else lensent := result;
@@ -552,6 +548,7 @@ procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
 var
   sendflushresult : integer;
   tempbuf:array[0..receivebufsize-1] of byte;
+  a:integer;
 begin
   if (state=wsconnected) and writetrigger then begin
     //writeln('write trigger');
@@ -564,7 +561,16 @@ begin
           internalclose(0);
 
         end else begin
-          internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+          {$ifdef win32}
+          if getlasterror=WSAEWOULDBLOCK then begin
+            //the asynchronous nature of windows messages means we sometimes
+            //get here with the buffer full
+            //so do nothing in that case
+          end else
+          {$endif}
+          begin
+            internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});
+          end  
         end;
       end;
 
@@ -578,7 +584,9 @@ begin
   writtenthiscycle := false;
   if (state =wsconnected) and readtrigger then begin
     if recvq.size=0 then begin
-      numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf));
+      a := recvbufsize;
+      if (a <= 0) or (a > sizeof(tempbuf)) then a := sizeof(tempbuf);
+      numread := myfdread(fdhandlein,tempbuf,a);
       if (numread=0) and (not mustrefreshfds) then begin
         {if i remember correctly numread=0 is caused by eof
         if this isn't dealt with then you get a cpu eating infinite loop
@@ -613,19 +621,20 @@ begin
   end;
 end;
 
-{$ifndef win32}
-  procedure tlasio.flush;
-  var
-    fds : fdset;
-  begin
-    fd_zero(fds);
-    fd_set(fdhandleout,fds);
-    while sendq.size>0 do begin
-      select(fdhandleout+1,nil,@fds,nil,nil);
-      if sendflush <= 0 then exit;
-    end;
-  end;
+procedure tlasio.flush;
+{$ifdef win32}
+type fdset = tfdset;
 {$endif}
+var
+  fds : fdset;
+begin
+  fd_zero(fds);
+  fd_set(fdhandleout,fds);
+  while sendq.size>0 do begin
+    select(fdhandleout+1,nil,@fds,nil,nil);
+    if sendflush <= 0 then exit;
+  end;
+end;
 
 procedure tlasio.dodatasent(wparam,lparam:longint);
 begin
@@ -728,8 +737,6 @@ begin
   end;
   interval := 1000;
   enabled := true;
-  released := false;
-
 end;
 
 destructor tltimer.destroy;
@@ -880,7 +887,6 @@ end;
 
 
 begin
-  firstasin := nil;
   firsttask := nil;