lcore.org gitweb
/
lcore.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fixed listen breaking on kernel compiled without ipv6
[lcore.git]
/
lcore.pas
diff --git
a/lcore.pas
b/lcore.pas
index 7db6b3ef2e5e50b5a54043ee0989a3fe7b10eace..1a2f93cb45efbb83552b07ee63c57289020786c8 100755
(executable)
--- a/
lcore.pas
+++ b/
lcore.pas
@@
-26,11
+26,11
@@
interface
{$ifdef VER1_0}
\r
linux,
\r
{$else}
\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
{$endif}
\r
fd_utils,
\r
{$endif}
\r
- classes,pgtypes,bfifo;
\r
+ classes,pgtypes,bfifo
,ltimevalstuff
;
\r
procedure processtasks;
\r
\r
\r
procedure processtasks;
\r
\r
\r
@@
-73,8
+73,9
@@
interface
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
\r
\r
tlcomponent = class(tcomponent)
\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
public
\r
- released:boolean;
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
end;
\r
procedure release; virtual;
\r
destructor destroy; override;
\r
end;
\r
@@
-94,8
+95,6
@@
interface
onsenddata : tsenddata ;
\r
ondatasent : tsocketevent ;
\r
//connected : boolean ;
\r
onsenddata : tsenddata ;
\r
ondatasent : tsocketevent ;
\r
//connected : boolean ;
\r
- nextasin : tlasio ;
\r
- prevasin : tlasio ;
\r
\r
recvq : tfifo;
\r
OnBgException : TBgExceptionEvent ;
\r
\r
recvq : tfifo;
\r
OnBgException : TBgExceptionEvent ;
\r
@@
-107,7
+106,7
@@
interface
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
lasterror:integer;
\r
destroying:boolean;
\r
recvbufsize:integer;
\r
- function receivestr:string; virtual;
\r
+ function receivestr:
tbuffer
string; virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
procedure close;
\r
procedure abort;
\r
procedure internalclose(error:word); virtual;
\r
@@
-120,8
+119,8
@@
interface
procedure dup(invalue:longint);
\r
\r
function sendflush : integer;
\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 :
tbuffer
string);virtual;
\r
+ procedure putstringinsendbuffer(const newstring :
tbuffer
string);
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
function send(data:pointer;len:integer):integer;virtual;
\r
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
\r
procedure deletebuffereddata;
\r
@@
-155,12
+154,6
@@
interface
var
\r
timerwrapperinterface : ttimerwrapperinterface;
\r
type
\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
tltimer=class(tlcomponent)
\r
protected
\r
\r
@@
-227,7
+220,6
@@
procedure messageloop;
procedure exitmessageloop;
\r
\r
var
\r
procedure exitmessageloop;
\r
\r
var
\r
- firstasin : tlasio ;
\r
firsttimer : tltimer ;
\r
firsttask , lasttask , currenttask : tltask ;
\r
\r
firsttimer : tltimer ;
\r
firsttask , lasttask , currenttask : tltask ;
\r
\r
@@
-262,35
+254,39
@@
implementation
{$ifndef win32}
\r
{$include unixstuff.inc}
\r
{$endif}
\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
\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
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
end;
\r
\r
+
\r
destructor tlcomponent.destroy;
\r
begin
\r
disconnecttasks(self);
\r
inherited destroy;
\r
end;
\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
\r
\r
procedure tlcomponent.release;
\r
begin
\r
-
released := true
;
\r
+
addtask(releasetaskhandler,self,0,0)
;
\r
end;
\r
\r
procedure tlasio.release;
\r
end;
\r
\r
procedure tlasio.release;
\r
@@
-343,26
+339,12
@@
begin
state := wsclosed;
\r
fdhandlein := -1;
\r
fdhandleout := -1;
\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
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
recvq.free;
\r
sendq.free;
\r
inherited destroy;
\r
@@
-405,6
+387,9
@@
end;
procedure tlasio.internalclose(error:word);
\r
begin
\r
if (state<>wsclosed) and (state<>wsinvalidstate) then begin
\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
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
@@
-459,13
+444,13
@@
begin
end;
\r
end;
\r
\r
end;
\r
end;
\r
\r
-procedure tlasio.sendstr(const str : string);
\r
+procedure tlasio.sendstr(const str :
tbuffer
string);
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
begin
\r
putstringinsendbuffer(str);
\r
sendflush;
\r
end;
\r
\r
-procedure tlasio.putstringinsendbuffer(const newstring : string);
\r
+procedure tlasio.putstringinsendbuffer(const newstring :
tbuffer
string);
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
begin
\r
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
\r
end;
\r
@@
-495,7
+480,10
@@
var
// fdstestr : fdset;
\r
// fdstestw : fdset;
\r
begin
\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
\r
lensent := sendq.get(data,packetbasesize*2);
\r
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
\r
@@
-749,8
+737,6
@@
begin
end;
\r
interval := 1000;
\r
enabled := true;
\r
end;
\r
interval := 1000;
\r
enabled := true;
\r
- released := false;
\r
-
\r
end;
\r
\r
destructor tltimer.destroy;
\r
end;
\r
\r
destructor tltimer.destroy;
\r
@@
-901,7
+887,6
@@
end;
\r
\r
begin
\r
\r
\r
begin
\r
- firstasin := nil;
\r
firsttask := nil;
\r
\r
\r
firsttask := nil;
\r
\r
\r