{$ifdef fpc}\r
{$mode delphi}\r
{$endif}\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
{$define nosignal}\r
{$endif}\r
interface\r
uses\r
sysutils,\r
- {$ifndef win32}\r
+ {$ifndef mswindows}\r
{$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
receivebufsize=packetbasesize*8;\r
\r
var\r
- absoloutemaxs:integer=0;\r
+ absolutemaxs:integer=0;\r
\r
type\r
{$ifdef ver1_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
public\r
state : tsocketstate ;\r
ComponentOptions : TWSocketOptions;\r
- fdhandlein : Longint ; {file discriptor}\r
- fdhandleout : Longint ; {file discriptor}\r
+ fdhandlein : Longint ; {file descriptor}\r
+ fdhandleout : Longint ; {file descriptor}\r
\r
onsessionclosed : tsocketevent ;\r
ondataAvailable : tsocketevent ;\r
onsenddata : tsenddata ;\r
ondatasent : tsocketevent ;\r
//connected : boolean ;\r
- nextasin : tlasio ;\r
- prevasin : tlasio ;\r
\r
recvq : tfifo;\r
OnBgException : TBgExceptionEvent ;\r
lasterror:integer;\r
destroying:boolean;\r
recvbufsize:integer;\r
- function receivestr:string; virtual;\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
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd\r
\r
- procedure myfdclose(fd : integer); virtual;{$ifdef win32}abstract;{$endif}\r
- function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}\r
- function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef win32}abstract;{$endif}\r
+ procedure myfdclose(fd : integer); virtual;{$ifdef mswindows}abstract;{$endif}\r
+ function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}\r
+ function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}\r
protected\r
procedure dupnowatch(invalue:longint);\r
end;\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
// finitialevent : boolean ;\r
fontimer : tnotifyevent ;\r
fenabled : boolean ;\r
- finterval : integer ; {miliseconds, default 1000}\r
- {$ifndef win32}\r
+ finterval : integer ; {milliseconds, default 1000}\r
+ {$ifndef mswindows}\r
procedure resettimes;\r
{$endif}\r
// procedure setinitialevent(newvalue : boolean);\r
procedure setenabled(newvalue : boolean);\r
procedure setinterval(newvalue : integer);\r
public\r
- //making theese public for now, this code should probablly be restructured later though\r
+ //making these public for now, this code should probably be restructured later though\r
prevtimer : tltimer ;\r
nexttimer : tltimer ;\r
nextts : ttimeval ;\r
procedure exitmessageloop;\r
\r
var\r
- firstasin : tlasio ;\r
firsttimer : tltimer ;\r
firsttask , lasttask , currenttask : tltask ;\r
\r
{$ifndef nosignal}\r
uses {sockets,}lloopback,lsignal;\r
{$endif}\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
uses windows,winsock;\r
{$endif}\r
-{$ifndef win32}\r
+{$ifndef mswindows}\r
{$include unixstuff.inc}\r
{$endif}\r
-{$include ltimevalstuff.inc}\r
\r
\r
{!!! added sleep call -beware}\r
procedure sleep(i:integer);\r
+{$ifdef mswindows}\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
\r
if closehandles then begin\r
- {$ifndef win32}\r
+ {$ifndef mswindows}\r
//anyone remember why this is here? --plugwash\r
fcntl(fdhandlein,F_SETFL,0);\r
{$endif}\r
myfdclose(fdhandlein);\r
if fdhandleout <> fdhandlein then begin\r
- {$ifndef win32}\r
+ {$ifndef mswindows}\r
fcntl(fdhandleout,F_SETFL,0);\r
{$endif}\r
myfdclose(fdhandleout);\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,packetbasesize*2);\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;\r
fdhandlein := invalue;\r
fdhandleout := invalue;\r
eventcore.setfdreverse(fdhandlein,self);\r
- {$ifndef win32}\r
+ {$ifndef mswindows}\r
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);\r
{$endif}\r
state := wsconnected;\r
internalclose(0);\r
\r
end else begin\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
if getlasterror=WSAEWOULDBLOCK then begin\r
//the asynchronous nature of windows messages means we sometimes\r
//get here with the buffer full\r
end else\r
{$endif}\r
begin\r
- internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif});\r
+ internalclose({$ifdef mswindows}getlasterror{$else}linuxerror{$endif});\r
end \r
end;\r
end;\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
- however if onsessionconencted has called processmessages that could\r
+ however if onsessionconnected has called processmessages that could\r
cause us to drop to here with an empty recvq and nothing left to read\r
and we don't want that to cause the socket to close}\r
\r
internalclose(0);\r
end else if (numread=-1) then begin\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
//sometimes on windows we get stale messages due to the inherent delays\r
//in the windows message queue\r
if WSAGetLastError = wsaewouldblock then begin\r
{$endif}\r
begin\r
numread := 0;\r
- internalclose({$ifdef win32}wsagetlasterror{$else}linuxerror{$endif});\r
+ internalclose({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});\r
end;\r
end else if numread > 0 then recvq.add(@tempbuf,numread);\r
end;\r
end;\r
\r
procedure tlasio.flush;\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
type fdset = tfdset;\r
{$endif}\r
var\r
tlasio(sender).recvq.del(maxlongint);\r
end;\r
\r
-{$ifndef win32}\r
+{$ifndef mswindows}\r
procedure tltimer.resettimes;\r
begin\r
gettimeofday(nextts);\r
if assigned(timerwrapperinterface) then begin\r
timerwrapperinterface.setenabled(wrappedtimer,newvalue);\r
end else begin\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
raise exception.create('non wrapper timers are not permitted on windows');\r
{$else}\r
resettimes;\r
if assigned(timerwrapperinterface) then begin\r
timerwrapperinterface.setinterval(wrappedtimer,newvalue);\r
end else begin\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
raise exception.create('non wrapper timers are not permitted on windows');\r
{$else}\r
resettimes;\r
end;\r
interval := 1000;\r
enabled := true;\r
- released := false;\r
-\r
end;\r
\r
destructor tltimer.destroy;\r
end else begin\r
currenttasklocal := currenttask; //needed in case called from a task\r
end;\r
- // note i don't bother to sestroy the links here as that will happen when\r
+ // note i don't bother to destroy the links here as that will happen when\r
// the list of tasks is processed anyway\r
while assigned(currenttasklocal) do begin\r
if currenttasklocal.obj = aobj then begin\r
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);\r
eventcore.wmasterset(fdhandleout);\r
end;\r
-{$ifndef win32}\r
+{$ifndef mswindows}\r
procedure tlasio.myfdclose(fd : integer);\r
begin\r
fdclose(fd);\r
\r
\r
begin\r
- firstasin := nil;\r
firsttask := nil;\r
\r
\r
lcore.org gitweb / lcore.git / blobdiff