X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..968c333d05db5d5ecf3599f8e304c67e64f21159:/lcore.pas?ds=inline diff --git a/lcore.pas b/lcore.pas index 900bc96..c936b59 100755 --- a/lcore.pas +++ b/lcore.pas @@ -16,26 +16,36 @@ unit lcore; {$ifdef fpc} {$mode delphi} {$endif} -{$ifdef win32} +{$ifdef mswindows} {$define nosignal} {$endif} interface uses sysutils, - {$ifndef win32} + {$ifndef mswindows} {$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; type {$ifdef ver1_0} @@ -63,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; @@ -84,8 +95,6 @@ interface onsenddata : tsenddata ; ondatasent : tsocketevent ; //connected : boolean ; - nextasin : tlasio ; - prevasin : tlasio ; recvq : tfifo; OnBgException : TBgExceptionEvent ; @@ -96,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; @@ -109,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); @@ -126,9 +136,9 @@ interface function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd - procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif} - function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif} - function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif} + procedure myfdclose(fd : integer); virtual;{$ifdef mswindows}abstract;{$endif} + function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif} + function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif} protected procedure dupnowatch(invalue:longint); end; @@ -144,12 +154,6 @@ interface var timerwrapperinterface : ttimerwrapperinterface; type - {$ifdef win32} - ttimeval = record - tv_sec : longint; - tv_usec : longint; - end; - {$endif} tltimer=class(tlcomponent) protected @@ -161,7 +165,7 @@ interface fontimer : tnotifyevent ; fenabled : boolean ; finterval : integer ; {miliseconds, default 1000} - {$ifndef win32} + {$ifndef mswindows} procedure resettimes; {$endif} // procedure setinitialevent(newvalue : boolean); @@ -216,7 +220,6 @@ procedure messageloop; procedure exitmessageloop; var - firstasin : tlasio ; firsttimer : tltimer ; firsttask , lasttask , currenttask : tltask ; @@ -245,41 +248,45 @@ implementation {$ifndef nosignal} uses {sockets,}lloopback,lsignal; {$endif} -{$ifdef win32} +{$ifdef mswindows} uses windows,winsock; {$endif} -{$ifndef win32} +{$ifndef mswindows} {$include unixstuff.inc} {$endif} -{$include ltimevalstuff.inc} {!!! added sleep call -beware} procedure sleep(i:integer); +{$ifdef mswindows} +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; @@ -326,33 +333,20 @@ end; constructor tlasio.create; begin inherited create(AOwner); + if not assigned(eventcore) then raise exception.create('no event core'); sendq := tfifo.create; recvq := tfifo.create; 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.destroy; - sendq.destroy; + recvq.free; + sendq.free; inherited destroy; end; @@ -392,19 +386,22 @@ end; procedure tlasio.internalclose(error:word); begin - if state<>wsclosed then 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); if closehandles then begin - {$ifndef win32} + {$ifndef mswindows} //anyone remember why this is here? --plugwash fcntl(fdhandlein,F_SETFL,0); {$endif} myfdclose(fdhandlein); if fdhandleout <> fdhandlein then begin - {$ifndef win32} + {$ifndef mswindows} fcntl(fdhandleout,F_SETFL,0); {$endif} myfdclose(fdhandleout); @@ -419,7 +416,7 @@ begin if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error); end; - sendq.del(maxlongint); + if assigned(sendq) then sendq.del(maxlongint); end; @@ -447,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; @@ -483,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; @@ -528,7 +528,7 @@ begin fdhandlein := invalue; fdhandleout := invalue; eventcore.setfdreverse(fdhandlein,self); - {$ifndef win32} + {$ifndef mswindows} fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK); {$endif} state := wsconnected; @@ -548,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'); @@ -560,7 +561,16 @@ begin internalclose(0); end else begin - internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif}); + {$ifdef mswindows} + 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 mswindows}getlasterror{$else}linuxerror{$endif}); + end end; end; @@ -574,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 @@ -584,7 +596,7 @@ begin internalclose(0); end else if (numread=-1) then begin - {$ifdef win32} + {$ifdef mswindows} //sometimes on windows we get stale messages due to the inherent delays //in the windows message queue if WSAGetLastError = wsaewouldblock then begin @@ -593,7 +605,7 @@ begin {$endif} begin numread := 0; - internalclose({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif}); + internalclose({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif}); end; end else if numread > 0 then recvq.add(@tempbuf,numread); end; @@ -609,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 mswindows} +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 @@ -638,7 +651,7 @@ begin tlasio(sender).recvq.del(maxlongint); end; -{$ifndef win32} +{$ifndef mswindows} procedure tltimer.resettimes; begin gettimeofday(nextts); @@ -679,7 +692,7 @@ begin if assigned(timerwrapperinterface) then begin timerwrapperinterface.setenabled(wrappedtimer,newvalue); end else begin - {$ifdef win32} + {$ifdef mswindows} raise exception.create('non wrapper timers are not permitted on windows'); {$else} resettimes; @@ -695,7 +708,7 @@ begin if assigned(timerwrapperinterface) then begin timerwrapperinterface.setinterval(wrappedtimer,newvalue); end else begin - {$ifdef win32} + {$ifdef mswindows} raise exception.create('non wrapper timers are not permitted on windows'); {$else} resettimes; @@ -724,8 +737,6 @@ begin end; interval := 1000; enabled := true; - released := false; - end; destructor tltimer.destroy; @@ -856,7 +867,7 @@ begin if (result > 0) and assigned(onsenddata) then onsenddata(self,result); eventcore.wmasterset(fdhandleout); end; -{$ifndef win32} +{$ifndef mswindows} procedure tlasio.myfdclose(fd : integer); begin fdclose(fd); @@ -876,7 +887,6 @@ end; begin - firstasin := nil; firsttask := nil;