X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/9b641f7a6cda5781002a12c901addc01787003e9..8e124815758c835d0d23347f944cd3feb56c5e73:/lcore.pas diff --git a/lcore.pas b/lcore.pas index da0fd66..c936b59 100755 --- a/lcore.pas +++ b/lcore.pas @@ -16,26 +16,32 @@ 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 - packetbasesize = 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 @@ -67,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; @@ -88,8 +95,6 @@ interface onsenddata : tsenddata ; ondatasent : tsocketevent ; //connected : boolean ; - nextasin : tlasio ; - prevasin : tlasio ; recvq : tfifo; OnBgException : TBgExceptionEvent ; @@ -101,7 +106,7 @@ interface lasterror:integer; destroying:boolean; recvbufsize:integer; - function receivestr:string; virtual; + function receivestr:tbufferstring; virtual; procedure close; procedure abort; procedure internalclose(error:word); virtual; @@ -114,8 +119,8 @@ 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; @@ -131,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; @@ -149,12 +154,6 @@ interface var timerwrapperinterface : ttimerwrapperinterface; type - {$ifdef win32} - ttimeval = record - tv_sec : longint; - tv_usec : longint; - end; - {$endif} tltimer=class(tlcomponent) protected @@ -166,7 +165,7 @@ interface fontimer : tnotifyevent ; fenabled : boolean ; finterval : integer ; {miliseconds, default 1000} - {$ifndef win32} + {$ifndef mswindows} procedure resettimes; {$endif} // procedure setinitialevent(newvalue : boolean); @@ -221,7 +220,6 @@ procedure messageloop; procedure exitmessageloop; var - firstasin : tlasio ; firsttimer : tltimer ; firsttask , lasttask , currenttask : tltask ; @@ -250,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; @@ -337,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; @@ -399,18 +387,21 @@ 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); 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); @@ -453,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; @@ -489,7 +480,10 @@ var // fdstestr : fdset; // fdstestw : fdset; begin - if state <> wsconnected then exit; + if state <> wsconnected then begin + result := -1; + exit; + end; lensent := sendq.get(data,packetbasesize*2); if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0; @@ -534,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; @@ -567,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; @@ -593,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 @@ -602,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; @@ -619,7 +622,7 @@ begin end; procedure tlasio.flush; -{$ifdef win32} +{$ifdef mswindows} type fdset = tfdset; {$endif} var @@ -648,7 +651,7 @@ begin tlasio(sender).recvq.del(maxlongint); end; -{$ifndef win32} +{$ifndef mswindows} procedure tltimer.resettimes; begin gettimeofday(nextts); @@ -689,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; @@ -705,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; @@ -734,8 +737,6 @@ begin end; interval := 1000; enabled := true; - released := false; - end; destructor tltimer.destroy; @@ -866,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); @@ -886,7 +887,6 @@ end; begin - firstasin := nil; firsttask := nil;