1 |
{lsocket.pas}
|
2 |
|
3 |
{io and timer code by plugwash}
|
4 |
|
5 |
{ Copyright (C) 2005 Bas Steendijk and Peter Green
|
6 |
For conditions of distribution and use, see copyright notice in zlib_license.txt
|
7 |
which is included in the package
|
8 |
----------------------------------------------------------------------------- }
|
9 |
|
10 |
{note: you must use the @ in the last param to tltask.create not doing so will
|
11 |
compile without error but will cause an access violation -pg}
|
12 |
|
13 |
//note: events after release are normal and are the apps responsibility to deal with safely
|
14 |
|
15 |
unit lcore;
|
16 |
{$ifdef fpc}
|
17 |
{$mode delphi}
|
18 |
{$endif}
|
19 |
{$ifdef mswindows}
|
20 |
{$define nosignal}
|
21 |
{$endif}
|
22 |
interface
|
23 |
uses
|
24 |
sysutils,
|
25 |
{$ifndef mswindows}
|
26 |
{$ifdef VER1_0}
|
27 |
linux,
|
28 |
{$else}
|
29 |
baseunix,unix,unixutil,sockets,
|
30 |
{$endif}
|
31 |
fd_utils,
|
32 |
{$endif}
|
33 |
classes,pgtypes,bfifo,ltimevalstuff;
|
34 |
procedure processtasks;
|
35 |
|
36 |
|
37 |
const
|
38 |
{how this number is made up:
|
39 |
- ethernet: MTU 1500
|
40 |
- be safe for either "ethernet v1" or "PPPoE", both take 8 bytes
|
41 |
- IPv6 header: 40 bytes (IPv4 is 20)
|
42 |
- TCP/UDP header: 20 bytes
|
43 |
}
|
44 |
packetbasesize = 1432;
|
45 |
receivebufsize=packetbasesize*8;
|
46 |
|
47 |
var
|
48 |
absolutemaxs:integer=0;
|
49 |
|
50 |
type
|
51 |
{$ifdef ver1_0}
|
52 |
sigset= array[0..31] of longint;
|
53 |
{$endif}
|
54 |
|
55 |
ESocketException = class(Exception);
|
56 |
TBgExceptionEvent = procedure (Sender : TObject;
|
57 |
E : Exception;
|
58 |
var CanClose : Boolean) of object;
|
59 |
|
60 |
// note : tsocketstate is defined in the same way as it is in François PIETTE's twsocket
|
61 |
// however tlsocket currently only uses wsClosed wsConnecting wsconnected and wsListening
|
62 |
TSocketState = (wsInvalidState,
|
63 |
wsOpened, wsBound,
|
64 |
wsConnecting, wsConnected,
|
65 |
wsAccepting, wsListening,
|
66 |
wsClosed);
|
67 |
|
68 |
TWSocketOption = (wsoNoReceiveLoop, wsoTcpNoDelay);
|
69 |
TWSocketOptions = set of TWSocketOption;
|
70 |
|
71 |
TSocketevent = procedure(Sender: TObject; Error: word) of object;
|
72 |
//Tdataavailevent = procedure(data : string);
|
73 |
TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;
|
74 |
|
75 |
tlcomponent = class(tcomponent)
|
76 |
private
|
77 |
procedure releasetaskhandler(wparam,lparam:longint);
|
78 |
public
|
79 |
procedure release; virtual;
|
80 |
destructor destroy; override;
|
81 |
end;
|
82 |
|
83 |
tlasio = class(tlcomponent)
|
84 |
public
|
85 |
state : tsocketstate ;
|
86 |
ComponentOptions : TWSocketOptions;
|
87 |
fdhandlein : Longint ; {file descriptor}
|
88 |
fdhandleout : Longint ; {file descriptor}
|
89 |
|
90 |
onsessionclosed : tsocketevent ;
|
91 |
ondataAvailable : tsocketevent ;
|
92 |
onsessionAvailable : tsocketevent ;
|
93 |
|
94 |
onsessionconnected : tsocketevent ;
|
95 |
onsenddata : tsenddata ;
|
96 |
ondatasent : tsocketevent ;
|
97 |
//connected : boolean ;
|
98 |
|
99 |
recvq : tfifo;
|
100 |
OnBgException : TBgExceptionEvent ;
|
101 |
//connectread : boolean ;
|
102 |
sendq : tfifo;
|
103 |
closehandles : boolean ;
|
104 |
writtenthiscycle : boolean ;
|
105 |
onfdwrite : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd
|
106 |
lasterror:integer;
|
107 |
destroying:boolean;
|
108 |
recvbufsize:integer;
|
109 |
datasentcalled:boolean;
|
110 |
{$ifdef mswindows}
|
111 |
sendflushlasterror:integer;
|
112 |
{$endif}
|
113 |
function receivestr:tbufferstring; virtual;
|
114 |
procedure close;
|
115 |
procedure abort;
|
116 |
procedure internalclose(error:word); virtual;
|
117 |
constructor Create(AOwner: TComponent); override;
|
118 |
|
119 |
destructor destroy; override;
|
120 |
procedure fdcleanup;
|
121 |
procedure HandleBackGroundException(E: Exception);
|
122 |
procedure handlefdtrigger(readtrigger,writetrigger:boolean); virtual;
|
123 |
procedure dup(invalue:longint);
|
124 |
|
125 |
function sendflush : integer;
|
126 |
procedure sendstr(const str : tbufferstring);virtual;
|
127 |
procedure putstringinsendbuffer(const newstring : tbufferstring);
|
128 |
function send(data:pointer;len:integer):integer;virtual;
|
129 |
procedure putdatainsendbuffer(data:pointer;len:integer); virtual;
|
130 |
procedure deletebuffereddata;
|
131 |
|
132 |
//procedure messageloop;
|
133 |
function Receive(Buf:Pointer;BufSize:integer):integer; virtual;
|
134 |
procedure flush;virtual;
|
135 |
procedure dodatasent(wparam,lparam:longint);
|
136 |
procedure doreceiveloop(wparam,lparam:longint);
|
137 |
procedure sinkdata(sender:tobject;error:word);
|
138 |
|
139 |
procedure release; override; {test -beware}
|
140 |
|
141 |
function RealSend(Data : Pointer; Len : Integer) : Integer; //added for bewarehttpd
|
142 |
|
143 |
procedure myfdclose(fd : integer); virtual;{$ifdef mswindows}abstract;{$endif}
|
144 |
function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
|
145 |
function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; virtual;{$ifdef mswindows}abstract;{$endif}
|
146 |
protected
|
147 |
procedure dupnowatch(invalue:longint);
|
148 |
end;
|
149 |
ttimerwrapperinterface=class(tlcomponent)
|
150 |
public
|
151 |
function createwrappedtimer : tobject;virtual;abstract;
|
152 |
// procedure setinitialevent(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
|
153 |
procedure setontimer(wrappedtimer : tobject;newvalue:tnotifyevent);virtual;abstract;
|
154 |
procedure setenabled(wrappedtimer : tobject;newvalue : boolean);virtual;abstract;
|
155 |
procedure setinterval(wrappedtimer : tobject;newvalue : integer);virtual;abstract;
|
156 |
end;
|
157 |
|
158 |
var
|
159 |
timerwrapperinterface : ttimerwrapperinterface;
|
160 |
type
|
161 |
tltimer=class(tlcomponent)
|
162 |
protected
|
163 |
|
164 |
|
165 |
wrappedtimer : tobject;
|
166 |
|
167 |
|
168 |
// finitialevent : boolean ;
|
169 |
fontimer : tnotifyevent ;
|
170 |
fenabled : boolean ;
|
171 |
finterval : integer ; {milliseconds, default 1000}
|
172 |
{$ifndef mswindows}
|
173 |
procedure resettimes;
|
174 |
{$endif}
|
175 |
// procedure setinitialevent(newvalue : boolean);
|
176 |
procedure setontimer(newvalue:tnotifyevent);
|
177 |
procedure setenabled(newvalue : boolean);
|
178 |
procedure setinterval(newvalue : integer);
|
179 |
public
|
180 |
//making these public for now, this code should probably be restructured later though
|
181 |
prevtimer : tltimer ;
|
182 |
nexttimer : tltimer ;
|
183 |
nextts : ttimeval ;
|
184 |
|
185 |
constructor create(aowner:tcomponent);override;
|
186 |
destructor destroy;override;
|
187 |
// property initialevent : boolean read finitialevent write setinitialevent;
|
188 |
property ontimer : tnotifyevent read fontimer write setontimer;
|
189 |
property enabled : boolean read fenabled write setenabled;
|
190 |
property interval : integer read finterval write setinterval;
|
191 |
|
192 |
end;
|
193 |
|
194 |
ttaskevent=procedure(wparam,lparam:longint) of object;
|
195 |
|
196 |
tltask=class(tobject)
|
197 |
public
|
198 |
handler : ttaskevent;
|
199 |
obj : tobject;
|
200 |
wparam : longint;
|
201 |
lparam : longint;
|
202 |
nexttask : tltask;
|
203 |
constructor create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
|
204 |
end;
|
205 |
|
206 |
|
207 |
|
208 |
teventcore=class
|
209 |
public
|
210 |
procedure processmessages; virtual;abstract;
|
211 |
procedure messageloop; virtual;abstract;
|
212 |
procedure exitmessageloop; virtual;abstract;
|
213 |
procedure setfdreverse(fd : integer;reverseto : tlasio);virtual;abstract;
|
214 |
procedure rmasterset(fd : integer;islistensocket : boolean); virtual;abstract;
|
215 |
procedure rmasterclr(fd: integer); virtual;abstract;
|
216 |
procedure wmasterset(fd : integer); virtual;abstract;
|
217 |
procedure wmasterclr(fd: integer); virtual;abstract;
|
218 |
end;
|
219 |
var
|
220 |
eventcore : teventcore;
|
221 |
|
222 |
procedure processmessages;
|
223 |
procedure messageloop;
|
224 |
procedure exitmessageloop;
|
225 |
|
226 |
var
|
227 |
firsttimer : tltimer ;
|
228 |
firsttask , lasttask , currenttask : tltask ;
|
229 |
|
230 |
numread : integer ;
|
231 |
mustrefreshfds : boolean ;
|
232 |
{ lcoretestcount:integer;}
|
233 |
|
234 |
asinreleaseflag:boolean;
|
235 |
|
236 |
|
237 |
procedure disconnecttasks(aobj:tobject);
|
238 |
procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
|
239 |
type
|
240 |
tonaddtask = procedure(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
|
241 |
var
|
242 |
onaddtask : tonaddtask;
|
243 |
|
244 |
|
245 |
procedure sleep(i:integer);
|
246 |
{$ifndef nosignal}
|
247 |
procedure prepsigpipe;{$ifndef ver1_0}inline;{$endif}
|
248 |
{$endif}
|
249 |
|
250 |
|
251 |
implementation
|
252 |
{$ifndef nosignal}
|
253 |
uses {sockets,}lloopback,lsignal;
|
254 |
{$endif}
|
255 |
{$ifdef mswindows}
|
256 |
uses windows,winsock;
|
257 |
{$endif}
|
258 |
{$ifndef mswindows}
|
259 |
{$include unixstuff.inc}
|
260 |
{$endif}
|
261 |
|
262 |
|
263 |
{!!! added sleep call -beware}
|
264 |
procedure sleep(i:integer);
|
265 |
{$ifdef mswindows}
|
266 |
begin
|
267 |
windows.sleep(i);
|
268 |
{$else}
|
269 |
var
|
270 |
tv:ttimeval;
|
271 |
begin
|
272 |
tv.tv_sec := i div 1000;
|
273 |
tv.tv_usec := (i mod 1000) * 1000;
|
274 |
select(0,nil,nil,nil,@tv);
|
275 |
{$endif}
|
276 |
end;
|
277 |
|
278 |
|
279 |
destructor tlcomponent.destroy;
|
280 |
begin
|
281 |
disconnecttasks(self);
|
282 |
inherited destroy;
|
283 |
end;
|
284 |
|
285 |
procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
|
286 |
begin
|
287 |
free;
|
288 |
end;
|
289 |
|
290 |
|
291 |
procedure tlcomponent.release;
|
292 |
begin
|
293 |
addtask(releasetaskhandler,self,0,0);
|
294 |
end;
|
295 |
|
296 |
procedure tlasio.release;
|
297 |
begin
|
298 |
asinreleaseflag := true;
|
299 |
inherited release;
|
300 |
end;
|
301 |
|
302 |
procedure tlasio.doreceiveloop;
|
303 |
begin
|
304 |
if recvq.size = 0 then exit;
|
305 |
if assigned(ondataavailable) then ondataavailable(self,0);
|
306 |
if not (wsonoreceiveloop in componentoptions) then
|
307 |
if recvq.size > 0 then tltask.create(self.doreceiveloop,self,0,0);
|
308 |
end;
|
309 |
|
310 |
function tlasio.receivestr;
|
311 |
begin
|
312 |
setlength(result,recvq.size);
|
313 |
receive(@result[1],length(result));
|
314 |
end;
|
315 |
|
316 |
function tlasio.receive(Buf:Pointer;BufSize:integer):integer;
|
317 |
var
|
318 |
i,a,b:integer;
|
319 |
p:pointer;
|
320 |
begin
|
321 |
i := bufsize;
|
322 |
if recvq.size < i then i := recvq.size;
|
323 |
a := 0;
|
324 |
while (a < i) do begin
|
325 |
b := recvq.get(p,i-a);
|
326 |
move(p^,buf^,b);
|
327 |
inc(taddrint(buf),b);
|
328 |
recvq.del(b);
|
329 |
inc(a,b);
|
330 |
end;
|
331 |
result := i;
|
332 |
if wsonoreceiveloop in componentoptions then begin
|
333 |
if recvq.size = 0 then eventcore.rmasterset(fdhandlein,false);
|
334 |
end;
|
335 |
end;
|
336 |
|
337 |
constructor tlasio.create;
|
338 |
begin
|
339 |
inherited create(AOwner);
|
340 |
if not assigned(eventcore) then raise exception.create('no event core');
|
341 |
sendq := tfifo.create;
|
342 |
recvq := tfifo.create;
|
343 |
state := wsclosed;
|
344 |
fdhandlein := -1;
|
345 |
fdhandleout := -1;
|
346 |
end;
|
347 |
|
348 |
destructor tlasio.destroy;
|
349 |
begin
|
350 |
destroying := true;
|
351 |
if state <> wsclosed then close;
|
352 |
recvq.free;
|
353 |
sendq.free;
|
354 |
inherited destroy;
|
355 |
end;
|
356 |
|
357 |
procedure tlasio.close;
|
358 |
begin
|
359 |
internalclose(0);
|
360 |
end;
|
361 |
|
362 |
procedure tlasio.abort;
|
363 |
begin
|
364 |
close;
|
365 |
end;
|
366 |
|
367 |
procedure tlasio.fdcleanup;
|
368 |
begin
|
369 |
if fdhandlein <> -1 then begin
|
370 |
eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster)
|
371 |
end;
|
372 |
if fdhandleout <> -1 then begin
|
373 |
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster)
|
374 |
end;
|
375 |
if fdhandlein=fdhandleout then begin
|
376 |
if fdhandlein <> -1 then begin
|
377 |
myfdclose(fdhandlein);
|
378 |
end;
|
379 |
end else begin
|
380 |
if fdhandlein <> -1 then begin
|
381 |
myfdclose(fdhandlein);
|
382 |
end;
|
383 |
if fdhandleout <> -1 then begin
|
384 |
myfdclose(fdhandleout);
|
385 |
end;
|
386 |
end;
|
387 |
fdhandlein := -1;
|
388 |
fdhandleout := -1;
|
389 |
end;
|
390 |
|
391 |
procedure tlasio.internalclose(error:word);
|
392 |
begin
|
393 |
if (state<>wsclosed) and (state<>wsinvalidstate) then begin
|
394 |
// -2 is a special indication that we should just exist silently
|
395 |
// (used for connect failure handling when socket creation fails)
|
396 |
if (fdhandlein = -2) and (fdhandleout = -2) then exit;
|
397 |
if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles');
|
398 |
eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster);
|
399 |
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
|
400 |
|
401 |
if closehandles then begin
|
402 |
{$ifndef mswindows}
|
403 |
//anyone remember why this is here? --plugwash
|
404 |
fcntl(fdhandlein,F_SETFL,0);
|
405 |
{$endif}
|
406 |
myfdclose(fdhandlein);
|
407 |
if fdhandleout <> fdhandlein then begin
|
408 |
{$ifndef mswindows}
|
409 |
fcntl(fdhandleout,F_SETFL,0);
|
410 |
{$endif}
|
411 |
myfdclose(fdhandleout);
|
412 |
end;
|
413 |
eventcore.setfdreverse(fdhandlein,nil);
|
414 |
eventcore.setfdreverse(fdhandleout,nil);
|
415 |
|
416 |
fdhandlein := -1;
|
417 |
fdhandleout := -1;
|
418 |
end;
|
419 |
state := wsclosed;
|
420 |
|
421 |
if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error);
|
422 |
end;
|
423 |
if assigned(sendq) then sendq.del(maxlongint);
|
424 |
end;
|
425 |
|
426 |
|
427 |
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
|
428 |
{ All exceptions *MUST* be handled. If an exception is not handled, the }
|
429 |
{ application will most likely be shut down ! }
|
430 |
procedure tlasio.HandleBackGroundException(E: Exception);
|
431 |
var
|
432 |
CanAbort : Boolean;
|
433 |
begin
|
434 |
CanAbort := TRUE;
|
435 |
{ First call the error event handler, if any }
|
436 |
if Assigned(OnBgException) then begin
|
437 |
try
|
438 |
OnBgException(Self, E, CanAbort);
|
439 |
except
|
440 |
end;
|
441 |
end;
|
442 |
{ Then abort the socket }
|
443 |
if CanAbort then begin
|
444 |
try
|
445 |
close;
|
446 |
except
|
447 |
end;
|
448 |
end;
|
449 |
end;
|
450 |
|
451 |
procedure tlasio.sendstr(const str : tbufferstring);
|
452 |
begin
|
453 |
putstringinsendbuffer(str);
|
454 |
sendflush;
|
455 |
end;
|
456 |
|
457 |
procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring);
|
458 |
begin
|
459 |
if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring));
|
460 |
end;
|
461 |
|
462 |
function tlasio.send(data:pointer;len:integer):integer;
|
463 |
begin
|
464 |
if state <> wsconnected then begin
|
465 |
result := -1;
|
466 |
exit;
|
467 |
end;
|
468 |
if len < 0 then len := 0;
|
469 |
result := len;
|
470 |
putdatainsendbuffer(data,len);
|
471 |
sendflush;
|
472 |
end;
|
473 |
|
474 |
|
475 |
procedure tlasio.putdatainsendbuffer(data:pointer;len:integer);
|
476 |
begin
|
477 |
sendq.add(data,len);
|
478 |
end;
|
479 |
|
480 |
function tlasio.sendflush : integer;
|
481 |
var
|
482 |
lensent : integer;
|
483 |
data:pointer;
|
484 |
// fdstestr : fdset;
|
485 |
// fdstestw : fdset;
|
486 |
begin
|
487 |
if state <> wsconnected then begin
|
488 |
result := -1;
|
489 |
exit;
|
490 |
end;
|
491 |
datasentcalled := false;
|
492 |
|
493 |
lensent := sendq.get(data,packetbasesize*2);
|
494 |
if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0;
|
495 |
|
496 |
if result = -1 then lensent := 0 else lensent := result;
|
497 |
|
498 |
{$ifdef mswindows}
|
499 |
if (result = -1) then sendflushlasterror := getlasterror else sendflushlasterror := 0;
|
500 |
{$endif}
|
501 |
|
502 |
//sendq := copy(sendq,lensent+1,length(sendq)-lensent);
|
503 |
sendq.del(lensent);
|
504 |
|
505 |
//fd_clr(fdhandleout,fdsw); // this prevents the socket being closed by a write
|
506 |
// that sends nothing because a previous socket has
|
507 |
// slready flushed this socket when the message loop
|
508 |
// reaches it
|
509 |
// if sendq.size > 0 then begin
|
510 |
eventcore.wmasterset(fdhandleout);//fd_set(fdhandleout,fdswmaster);
|
511 |
// end else begin
|
512 |
// wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
|
513 |
// end;
|
514 |
if result > 0 then begin
|
515 |
if assigned(onsenddata) then onsenddata(self,result);
|
516 |
// if sendq.size=0 then if assigned(ondatasent) then begin
|
517 |
// tltask.create(self.dodatasent,self,0,0);
|
518 |
// //begin test code
|
519 |
// fd_zero(fdstestr);
|
520 |
// fd_zero(fdstestw);
|
521 |
// fd_set(fdhandlein,fdstestr);
|
522 |
// fd_set(fdhandleout,fdstestw);
|
523 |
// select(maxs,@fdstestr,@fdstestw,nil,0);
|
524 |
// writeln(fd_isset(fdhandlein,fdstestr),' ',fd_isset(fdhandleout,fdstestw));
|
525 |
// //end test code
|
526 |
//
|
527 |
// end;
|
528 |
writtenthiscycle := true;
|
529 |
end;
|
530 |
end;
|
531 |
|
532 |
procedure tlasio.dupnowatch(invalue:longint);
|
533 |
begin
|
534 |
{ debugout('invalue='+inttostr(invalue));}
|
535 |
//readln;
|
536 |
if state<> wsclosed then close;
|
537 |
fdhandlein := invalue;
|
538 |
fdhandleout := invalue;
|
539 |
eventcore.setfdreverse(fdhandlein,self);
|
540 |
{$ifndef mswindows}
|
541 |
fcntl(fdhandlein,F_SETFL,OPEN_NONBLOCK);
|
542 |
{$endif}
|
543 |
state := wsconnected;
|
544 |
|
545 |
end;
|
546 |
|
547 |
|
548 |
procedure tlasio.dup(invalue:longint);
|
549 |
begin
|
550 |
dupnowatch(invalue);
|
551 |
eventcore.rmasterset(fdhandlein,false);//fd_set(fdhandlein,fdsrmaster);
|
552 |
eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
|
553 |
end;
|
554 |
|
555 |
|
556 |
procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean);
|
557 |
var
|
558 |
sendflushresult : integer;
|
559 |
tempbuf:array[0..receivebufsize-1] of byte;
|
560 |
a:integer;
|
561 |
begin
|
562 |
if (state=wsconnected) and writetrigger then begin
|
563 |
//writeln('write trigger');
|
564 |
|
565 |
if (sendq.size >0) then begin
|
566 |
|
567 |
sendflushresult := sendflush;
|
568 |
if (sendflushresult <= 0) and (not writtenthiscycle) then begin
|
569 |
if sendflushresult=0 then begin // linuxerror := 0;
|
570 |
internalclose(0);
|
571 |
|
572 |
end else begin
|
573 |
{$ifdef mswindows}
|
574 |
if sendflushlasterror=WSAEWOULDBLOCK then begin
|
575 |
//the asynchronous nature of windows messages means we sometimes
|
576 |
//get here with the buffer full
|
577 |
//so do nothing in that case
|
578 |
end else
|
579 |
{$endif}
|
580 |
begin
|
581 |
internalclose({$ifdef mswindows}sendflushlasterror{$else}linuxerror{$endif});
|
582 |
end
|
583 |
end;
|
584 |
end;
|
585 |
|
586 |
end else begin
|
587 |
//everything is sent fire off ondatasent event
|
588 |
if fdhandleout >= 0 then eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster);
|
589 |
if assigned(ondatasent) then begin
|
590 |
if not datasentcalled then begin
|
591 |
tltask.create(self.dodatasent,self,0,0);
|
592 |
datasentcalled := true;
|
593 |
end;
|
594 |
end;
|
595 |
|
596 |
end;
|
597 |
if assigned(onfdwrite) then onfdwrite(self,0);
|
598 |
end;
|
599 |
writtenthiscycle := false;
|
600 |
if (state =wsconnected) and readtrigger then begin
|
601 |
if recvq.size=0 then begin
|
602 |
a := recvbufsize;
|
603 |
if (a <= 0) or (a > sizeof(tempbuf)) then a := sizeof(tempbuf);
|
604 |
numread := myfdread(fdhandlein,tempbuf,a);
|
605 |
if (numread=0) and (not mustrefreshfds) then begin
|
606 |
{if i remember correctly numread=0 is caused by eof
|
607 |
if this isn't dealt with then you get a cpu eating infinite loop
|
608 |
however if onsessionconnected has called processmessages that could
|
609 |
cause us to drop to here with an empty recvq and nothing left to read
|
610 |
and we don't want that to cause the socket to close}
|
611 |
|
612 |
internalclose(0);
|
613 |
end else if (numread=-1) then begin
|
614 |
{$ifdef mswindows}
|
615 |
//sometimes on windows we get stale messages due to the inherent delays
|
616 |
//in the windows message queue
|
617 |
if WSAGetLastError = wsaewouldblock then begin
|
618 |
//do nothing
|
619 |
end else
|
620 |
{$endif}
|
621 |
begin
|
622 |
numread := 0;
|
623 |
internalclose({$ifdef mswindows}wsagetlasterror{$else}linuxerror{$endif});
|
624 |
end;
|
625 |
end else if numread > 0 then recvq.add(@tempbuf,numread);
|
626 |
end;
|
627 |
|
628 |
if recvq.size > 0 then begin
|
629 |
if wsonoreceiveloop in componentoptions then eventcore.rmasterclr(fdhandlein); //fd_clr(fdhandlein,fdsrmaster);
|
630 |
if assigned(ondataavailable) then ondataAvailable(self,0);
|
631 |
if not (wsonoreceiveloop in componentoptions) then if recvq.size > 0 then
|
632 |
tltask.create(self.doreceiveloop,self,0,0);
|
633 |
end;
|
634 |
//until (numread = 0) or (currentsocket.state<>wsconnected);
|
635 |
{ debugout('inner loop complete');}
|
636 |
end;
|
637 |
end;
|
638 |
|
639 |
procedure tlasio.flush;
|
640 |
{$ifdef mswindows}
|
641 |
type fdset = tfdset;
|
642 |
{$endif}
|
643 |
var
|
644 |
fds : fdset;
|
645 |
begin
|
646 |
fd_zero(fds);
|
647 |
fd_set(fdhandleout,fds);
|
648 |
while sendq.size>0 do begin
|
649 |
select(fdhandleout+1,nil,@fds,nil,nil);
|
650 |
if sendflush <= 0 then exit;
|
651 |
end;
|
652 |
end;
|
653 |
|
654 |
procedure tlasio.dodatasent(wparam,lparam:longint);
|
655 |
begin
|
656 |
if assigned(ondatasent) then ondatasent(self,lparam);
|
657 |
end;
|
658 |
|
659 |
procedure tlasio.deletebuffereddata;
|
660 |
begin
|
661 |
sendq.del(maxlongint);
|
662 |
end;
|
663 |
|
664 |
procedure tlasio.sinkdata(sender:tobject;error:word);
|
665 |
begin
|
666 |
tlasio(sender).recvq.del(maxlongint);
|
667 |
end;
|
668 |
|
669 |
{$ifndef mswindows}
|
670 |
procedure tltimer.resettimes;
|
671 |
begin
|
672 |
gettimeofday(nextts);
|
673 |
{if not initialevent then} tv_add(nextts,interval);
|
674 |
end;
|
675 |
{$endif}
|
676 |
|
677 |
{procedure tltimer.setinitialevent(newvalue : boolean);
|
678 |
begin
|
679 |
if newvalue <> finitialevent then begin
|
680 |
finitialevent := newvalue;
|
681 |
if assigned(timerwrapperinterface) then begin
|
682 |
timerwrapperinterface.setinitialevent(wrappedtimer,newvalue);
|
683 |
end else begin
|
684 |
resettimes;
|
685 |
end;
|
686 |
end;
|
687 |
end;}
|
688 |
|
689 |
procedure tltimer.setontimer(newvalue:tnotifyevent);
|
690 |
begin
|
691 |
if @newvalue <> @fontimer then begin
|
692 |
fontimer := newvalue;
|
693 |
if assigned(timerwrapperinterface) then begin
|
694 |
timerwrapperinterface.setontimer(wrappedtimer,newvalue);
|
695 |
end else begin
|
696 |
|
697 |
end;
|
698 |
end;
|
699 |
|
700 |
end;
|
701 |
|
702 |
|
703 |
procedure tltimer.setenabled(newvalue : boolean);
|
704 |
begin
|
705 |
if newvalue <> fenabled then begin
|
706 |
fenabled := newvalue;
|
707 |
if assigned(timerwrapperinterface) then begin
|
708 |
timerwrapperinterface.setenabled(wrappedtimer,newvalue);
|
709 |
end else begin
|
710 |
{$ifdef mswindows}
|
711 |
raise exception.create('non wrapper timers are not permitted on windows');
|
712 |
{$else}
|
713 |
resettimes;
|
714 |
{$endif}
|
715 |
end;
|
716 |
end;
|
717 |
end;
|
718 |
|
719 |
procedure tltimer.setinterval(newvalue:integer);
|
720 |
begin
|
721 |
if newvalue <> finterval then begin
|
722 |
finterval := newvalue;
|
723 |
if assigned(timerwrapperinterface) then begin
|
724 |
timerwrapperinterface.setinterval(wrappedtimer,newvalue);
|
725 |
end else begin
|
726 |
{$ifdef mswindows}
|
727 |
raise exception.create('non wrapper timers are not permitted on windows');
|
728 |
{$else}
|
729 |
resettimes;
|
730 |
{$endif}
|
731 |
end;
|
732 |
end;
|
733 |
|
734 |
end;
|
735 |
|
736 |
|
737 |
|
738 |
|
739 |
constructor tltimer.create;
|
740 |
begin
|
741 |
inherited create(AOwner);
|
742 |
if assigned(timerwrapperinterface) then begin
|
743 |
wrappedtimer := timerwrapperinterface.createwrappedtimer;
|
744 |
end else begin
|
745 |
|
746 |
|
747 |
nexttimer := firsttimer;
|
748 |
prevtimer := nil;
|
749 |
|
750 |
if assigned(nexttimer) then nexttimer.prevtimer := self;
|
751 |
firsttimer := self;
|
752 |
end;
|
753 |
interval := 1000;
|
754 |
enabled := true;
|
755 |
end;
|
756 |
|
757 |
destructor tltimer.destroy;
|
758 |
begin
|
759 |
if assigned(timerwrapperinterface) then begin
|
760 |
wrappedtimer.free;
|
761 |
end else begin
|
762 |
if prevtimer <> nil then begin
|
763 |
prevtimer.nexttimer := nexttimer;
|
764 |
end else begin
|
765 |
firsttimer := nexttimer;
|
766 |
end;
|
767 |
if nexttimer <> nil then begin
|
768 |
nexttimer.prevtimer := prevtimer;
|
769 |
end;
|
770 |
|
771 |
end;
|
772 |
inherited destroy;
|
773 |
end;
|
774 |
|
775 |
constructor tltask.create(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
|
776 |
begin
|
777 |
inherited create;
|
778 |
if assigned(onaddtask) then onaddtask(ahandler,aobj,awparam,alparam);
|
779 |
handler := ahandler;
|
780 |
obj := aobj;
|
781 |
wparam := awparam;
|
782 |
lparam := alparam;
|
783 |
{nexttask := firsttask;
|
784 |
firsttask := self;}
|
785 |
if assigned(lasttask) then begin
|
786 |
lasttask.nexttask := self;
|
787 |
end else begin
|
788 |
firsttask := self;
|
789 |
end;
|
790 |
lasttask := self;
|
791 |
//ahandler(wparam,lparam);
|
792 |
end;
|
793 |
|
794 |
procedure addtask(ahandler:ttaskevent;aobj:tobject;awparam,alparam:longint);
|
795 |
begin
|
796 |
|
797 |
tltask.create(ahandler,aobj,awparam,alparam);
|
798 |
end;
|
799 |
|
800 |
{$ifndef nosignal}
|
801 |
procedure prepsigpipe;{$ifndef ver1_0}inline;
|
802 |
{$endif}
|
803 |
begin
|
804 |
starthandlesignal(sigpipe);
|
805 |
if not assigned(signalloopback) then begin
|
806 |
signalloopback := tlloopback.create(nil);
|
807 |
signalloopback.ondataAvailable := signalloopback.sinkdata;
|
808 |
|
809 |
end;
|
810 |
|
811 |
end;
|
812 |
{$endif}
|
813 |
|
814 |
procedure processtasks;//inline;
|
815 |
var
|
816 |
temptask : tltask ;
|
817 |
|
818 |
begin
|
819 |
|
820 |
if not assigned(currenttask) then begin
|
821 |
currenttask := firsttask;
|
822 |
firsttask := nil;
|
823 |
lasttask := nil;
|
824 |
end;
|
825 |
while assigned(currenttask) do begin
|
826 |
|
827 |
if assigned(currenttask.handler) then currenttask.handler(currenttask.wparam,currenttask.lparam);
|
828 |
if assigned(currenttask) then begin
|
829 |
temptask := currenttask;
|
830 |
currenttask := currenttask.nexttask;
|
831 |
temptask.free;
|
832 |
end;
|
833 |
//writeln('processed a task');
|
834 |
end;
|
835 |
|
836 |
end;
|
837 |
|
838 |
|
839 |
|
840 |
|
841 |
procedure disconnecttasks(aobj:tobject);
|
842 |
var
|
843 |
currenttasklocal : tltask ;
|
844 |
counter : byte ;
|
845 |
begin
|
846 |
for counter := 0 to 1 do begin
|
847 |
if counter = 0 then begin
|
848 |
currenttasklocal := firsttask; //main list of tasks
|
849 |
end else begin
|
850 |
currenttasklocal := currenttask; //needed in case called from a task
|
851 |
end;
|
852 |
// note i don't bother to destroy the links here as that will happen when
|
853 |
// the list of tasks is processed anyway
|
854 |
while assigned(currenttasklocal) do begin
|
855 |
if currenttasklocal.obj = aobj then begin
|
856 |
currenttasklocal.obj := nil;
|
857 |
currenttasklocal.handler := nil;
|
858 |
end;
|
859 |
currenttasklocal := currenttasklocal.nexttask;
|
860 |
end;
|
861 |
end;
|
862 |
end;
|
863 |
|
864 |
|
865 |
procedure processmessages;
|
866 |
begin
|
867 |
eventcore.processmessages;
|
868 |
end;
|
869 |
procedure messageloop;
|
870 |
begin
|
871 |
eventcore.messageloop;
|
872 |
end;
|
873 |
|
874 |
procedure exitmessageloop;
|
875 |
begin
|
876 |
eventcore.exitmessageloop;
|
877 |
end;
|
878 |
|
879 |
function tlasio.RealSend(Data : Pointer; Len : Integer) : Integer;
|
880 |
begin
|
881 |
result := myfdwrite(fdhandleout,data^,len);
|
882 |
if (result > 0) and assigned(onsenddata) then onsenddata(self,result);
|
883 |
eventcore.wmasterset(fdhandleout);
|
884 |
end;
|
885 |
{$ifndef mswindows}
|
886 |
procedure tlasio.myfdclose(fd : integer);
|
887 |
begin
|
888 |
fdclose(fd);
|
889 |
end;
|
890 |
function tlasio.myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt;
|
891 |
begin
|
892 |
result := fdwrite(fd,buf,size);
|
893 |
end;
|
894 |
|
895 |
function tlasio.myfdread(fd: LongInt;var buf;size: LongInt):LongInt;
|
896 |
begin
|
897 |
result := fdread(fd,buf,size);
|
898 |
end;
|
899 |
|
900 |
|
901 |
{$endif}
|
902 |
|
903 |
|
904 |
begin
|
905 |
firsttask := nil;
|
906 |
|
907 |
|
908 |
{$ifndef nosignal}
|
909 |
signalloopback := nil;
|
910 |
{$endif}
|
911 |
end.
|
912 |
|
913 |
|
914 |
|
915 |
|
916 |
|