X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..b75c4f1cb9e048c35d3242cece45de07eb43282e:/lcore.pas
diff --git a/lcore.pas b/lcore.pas
index 30e9c09..0f6eaef 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,7 +254,6 @@ implementation
{$ifndef win32}
{$include unixstuff.inc}
{$endif}
-{$include ltimevalstuff.inc}
{!!! added sleep call -beware}
@@ -277,12 +276,15 @@ begin
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 +337,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 +385,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 +442,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 +478,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 +546,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 +559,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 +582,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 +619,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 +735,6 @@ begin
end;
interval := 1000;
enabled := true;
- released := false;
-
end;
destructor tltimer.destroy;
@@ -880,7 +885,6 @@ end;
begin
- firstasin := nil;
firsttask := nil;