{$ifdef VER1_0}\r
linux,\r
{$else}\r
- baseunix,unix,unixutil,\r
+ baseunix,unix,unixutil,sockets,\r
{$endif}\r
fd_utils,\r
{$endif}\r
- classes,pgtypes,bfifo;\r
+ classes,pgtypes,bfifo,ltimevalstuff;\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
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;\r
\r
tlcomponent = class(tcomponent)\r
+ private\r
+ procedure releasetaskhandler(wparam,lparam:longint);\r
public\r
- released:boolean;\r
procedure release; virtual;\r
destructor destroy; override;\r
end;\r
onsenddata : tsenddata ;\r
ondatasent : tsocketevent ;\r
//connected : boolean ;\r
- nextasin : tlasio ;\r
- prevasin : tlasio ;\r
\r
recvq : tfifo;\r
OnBgException : TBgExceptionEvent ;\r
onfdwrite : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd\r
lasterror:integer;\r
destroying:boolean;\r
- function receivestr:string; virtual;\r
+ recvbufsize:integer;\r
+ function receivestr:tbufferstring; virtual;\r
procedure close;\r
procedure abort;\r
procedure internalclose(error:word); virtual;\r
procedure dup(invalue:longint);\r
\r
function sendflush : integer;\r
- procedure sendstr(const str : string);virtual;\r
- procedure putstringinsendbuffer(const newstring : string);\r
+ procedure sendstr(const str : tbufferstring);virtual;\r
+ procedure putstringinsendbuffer(const newstring : tbufferstring);\r
function send(data:pointer;len:integer):integer;virtual;\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;\r
procedure deletebuffereddata;\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
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
procedure exitmessageloop;\r
\r
var\r
- firstasin : tlasio ;\r
firsttimer : tltimer ;\r
firsttask , lasttask , currenttask : tltask ;\r
\r
{$ifndef win32}\r
{$include unixstuff.inc}\r
{$endif}\r
-{$include ltimevalstuff.inc}\r
\r
\r
{!!! added sleep call -beware}\r
procedure sleep(i:integer);\r
+{$ifdef win32}\r
+begin\r
+ windows.sleep(i);\r
+{$else}\r
var\r
tv:ttimeval;\r
begin\r
- {$ifdef win32}\r
- windows.sleep(i);\r
- {$else}\r
- tv.tv_sec := i div 1000;\r
- tv.tv_usec := (i mod 1000) * 1000;\r
- select(0,nil,nil,nil,@tv);\r
- {$endif}\r
+ tv.tv_sec := i div 1000;\r
+ tv.tv_usec := (i mod 1000) * 1000;\r
+ select(0,nil,nil,nil,@tv);\r
+{$endif}\r
end;\r
\r
+\r
destructor tlcomponent.destroy;\r
begin\r
disconnecttasks(self);\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
- released := true;\r
+ addtask(releasetaskhandler,self,0,0);\r
end;\r
\r
procedure tlasio.release;\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
- 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
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
end;\r
end;\r
\r
-procedure tlasio.sendstr(const str : string);\r
+procedure tlasio.sendstr(const str : tbufferstring);\r
begin\r
putstringinsendbuffer(str);\r
sendflush;\r
end;\r
\r
-procedure tlasio.putstringinsendbuffer(const newstring : string);\r
+procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);\r
begin\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));\r
end;\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
- 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
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
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
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
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
+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
end;\r
interval := 1000;\r
enabled := true;\r
- released := false;\r
-\r
end;\r
\r
destructor tltimer.destroy;\r
\r
\r
begin\r
- firstasin := nil;\r
firsttask := nil;\r
\r
\r
lcore.org gitweb / lcore.git / blobdiff