/[lcore]/trunk/lcoreselect.pas
ViewVC logotype

Contents of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (show annotations)
Fri Dec 26 19:17:00 2008 UTC (10 years, 11 months ago) by beware
File size: 11994 byte(s)
* fixed NT services not working. app must now call lcoreinit() at some point before using sockets etc
* made dnssync and dnsasync secure with source port randomization and reply packet source IP/port verification
* created lcorerandom, a secure general purpose random number source, replacement of bircrandom
* added fastmd5.pas into the repository. it wasn't in it, but seemed to belong in it and lcorernd depends on it.
* added the ability to do "custom" (txt, mx, ns, ptr, etc) lookups in dnscore and dnsasync
* lsocket.receivefrom now converts a v6 mapped v4 IP to a real v4 IP for simplicity in the app
* removed "ipv6preferred" from dnswin, which was doing nothing


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 {$ifdef fpc}
11 {$ifndef ver1_0}
12 {$define useinline}
13 {$endif}
14 {$endif}
15
16 unit lcoreselect;
17
18
19 interface
20 uses
21 {$ifdef VER1_0}
22 linux,
23 {$else}
24 baseunix,unix,unixutil,
25 {$endif}
26 fd_utils;
27 var
28 maxs : longint ;
29 exitloopflag : boolean ; {if set by app, exit mainloop}
30
31 function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}
32 function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}
33
34 procedure lcoreinit;
35
36 implementation
37 uses
38 lcore,sysutils,
39 classes,pgtypes,bfifo,
40 {$ifndef nosignal}
41 lsignal;
42 {$endif}
43
44 {$include unixstuff.inc}
45 {$include ltimevalstuff.inc}
46
47 const
48 absoloutemaxs_select = (sizeof(fdset)*8)-1;
49
50 var
51 fdreverse:array[0..absoloutemaxs_select] of tlasio;
52 type
53 tselecteventcore=class(teventcore)
54 public
55 procedure processmessages; override;
56 procedure messageloop; override;
57 procedure exitmessageloop;override;
58 procedure setfdreverse(fd : integer;reverseto : tlasio); override;
59 procedure rmasterset(fd : integer;islistensocket : boolean); override;
60 procedure rmasterclr(fd: integer); override;
61 procedure wmasterset(fd : integer); override;
62 procedure wmasterclr(fd: integer); override;
63 end;
64
65 procedure processtimers;inline;
66 var
67 tv ,tvnow : ttimeval ;
68 currenttimer : tltimer ;
69 temptimer : tltimer ;
70
71 begin
72 gettimeofday(tvnow);
73 currenttimer := firsttimer;
74 while assigned(currenttimer) do begin
75 //writeln(currenttimer.enabled);
76 if tv_compare(tvnow,ttimeval(currenttimer.nextts)) and currenttimer.enabled then begin
77 //if assigned(currenttimer.ontimer) then begin
78 // if currenttimer.enabled then if currenttimer.initialevent or currenttimer.initialdone then currenttimer.ontimer(currenttimer);
79 // currenttimer.initialdone := true;
80 //end;
81 if assigned(currenttimer.ontimer) then currenttimer.ontimer(currenttimer);
82 currenttimer.nextts := timeval(tvnow);
83 tv_add(ttimeval(currenttimer.nextts),currenttimer.interval);
84 end;
85 temptimer := currenttimer;
86 currenttimer := currenttimer.nexttimer;
87 if temptimer.released then temptimer.free;
88 end;
89 end;
90
91 procedure processasios(var fdsr,fdsw:fdset);//inline;
92 var
93 currentsocket : tlasio ;
94 tempsocket : tlasio ;
95 socketcount : integer ; // for debugging perposes :)
96 dw,bt:integer;
97 begin
98 { inc(lcoretestcount);}
99
100 //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
101 //if (not assigned(firstasin)) and (not assigned(firsttimer)) and (not assigned(firstsignal)) then exit;
102
103
104 {------- test optimised loop}
105 socketcount := 0;
106 for dw := (maxs shr 5) downto 0 do if (fdsr[dw] or fdsw[dw]) <> 0 then begin
107 for bt := 0 to 31 do if (fdsr[dw] or fdsw[dw]) and (1 shl bt) <> 0 then begin
108 inc(socketcount);
109 currentsocket := fdreverse[dw shl 5 or bt];
110 {if not assigned(currentsocket) then raise exception.create('currentsocket not assigned');
111 if currentsocket.fdhandlein < 0 then raise exception.create('currentsocket.fdhandlein out of range');}
112 {i've seen the out of range case actually happening, so it can happen. test: just close the fd - beware}
113 if not assigned(currentsocket) then begin
114 fdclose(dw shl 5 or bt);
115 continue
116 end;
117 if currentsocket.fdhandlein < 0 then begin
118 fdclose(dw shl 5 or bt);
119 continue
120 end;
121 try
122 currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
123 except
124 on E: exception do begin
125 currentsocket.HandleBackGroundException(e);
126 end;
127 end;
128
129 if mustrefreshfds then begin
130 if select(maxs+1,@fdsr,@fdsw,nil,0) <= 0 then begin
131 fd_zero(fdsr);
132 fd_zero(fdsw);
133 end;
134 end;
135 end;
136 end;
137
138 if asinreleaseflag then begin
139 asinreleaseflag := false;
140 currentsocket := firstasin;
141 while assigned(currentsocket) do begin
142 tempsocket := currentsocket;
143 currentsocket := currentsocket.nextasin;
144 if tempsocket.released then begin
145 tempsocket.free;
146 end;
147 end;
148 end;
149 {
150 !!! issues:
151 - sockets which are released may not be freed because theyre never processed by the loop
152 made new code for handling this, using asinreleaseflag
153
154 - when/why does the mustrefreshfds select apply, sheck if i did it correctly?
155
156 - what happens if calling handlefdtrigger for a socket which does not have an event
157 }
158 {------- original loop}
159
160 (*
161 currentsocket := firstasin;
162 socketcount := 0;
163 while assigned(currentsocket) do begin
164 if mustrefreshfds then begin
165 if select(maxs,@fdsr,@fdsw,nil,0) <= 0 then begin
166 fd_zero(fdsr);
167 fd_zero(fdsw);
168 end;
169 end;
170 try
171 if fd_isset(currentsocket.fdhandlein,fdsr) or fd_isset(currentsocket.fdhandleout,fdsw) then begin
172 currentsocket.handlefdtrigger(fd_isset(currentsocket.fdhandlein,fdsr),fd_isset(currentsocket.fdhandleout,fdsw));
173 end;
174 except
175 on E: exception do begin
176 currentsocket.HandleBackGroundException(e);
177 end;
178 end;
179 tempsocket := currentsocket;
180 currentsocket := currentsocket.nextasin;
181 inc(socketcount);
182 if tempsocket.released then begin
183 tempsocket.free;
184 end;
185 end; *)
186 { debugout('socketcount='+inttostr(socketcount));}
187 end;
188
189 procedure tselecteventcore.processmessages;
190 var
191 fdsr , fdsw : fdset ;
192 selectresult : longint ;
193 begin
194 mustrefreshfds := false;
195 {$ifndef nosignal}
196 prepsigpipe;
197 {$endif}
198 selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
199 while (selectresult>0) or assigned(firsttask) or assigned(currenttask) do begin;
200
201 processtasks;
202 processtimers;
203 if selectresult > 0 then begin
204 processasios(fdsr,fdsw);
205 end;
206 selectresult := select(maxs+1,@fdsr,@fdsw,nil,0);
207
208 end;
209 mustrefreshfds := true;
210 end;
211
212
213 var
214 FDSR , FDSW : fdset;
215
216 var
217 fdsrmaster , fdswmaster : fdset ;
218
219 function getfdsrmaster : fdset; {$ifdef fpc}inline;{$endif}
220 begin
221 result := fdsrmaster;
222 end;
223 function getfdswmaster : fdset; {$ifdef fpc}inline;{$endif}
224 begin
225 result := fdswmaster;
226 end;
227
228
229 Function doSelect(timeOut:PTimeVal):longint;//inline;
230 var
231 localtimeval : ttimeval;
232 maxslocal : integer;
233 begin
234 //unblock signals
235 //zeromemory(@sset,sizeof(sset));
236 //sset[0] := ;
237 fdsr := getfdsrmaster;
238 fdsw := getfdswmaster;
239
240 if assigned(firsttask) then begin
241 localtimeval.tv_sec := 0;
242 localtimeval.tv_usec := 0;
243 timeout := @localtimeval;
244 end;
245
246 maxslocal := maxs;
247 mustrefreshfds := false;
248 { debugout('about to call select');}
249 {$ifndef nosignal}
250 sigprocmask(SIG_UNBLOCK,@blockset,nil);
251 {$endif}
252 result := select(maxslocal+1,@FDSR,@FDSW,nil,timeout);
253 if result <= 0 then begin
254 fd_zero(FDSR);
255 fd_zero(FDSW);
256 if result=-1 then begin
257 if linuxerror = SYS_EINTR then begin
258 // we received a signal it's not a problem
259 end else begin
260 raise esocketexception.create('select returned error '+inttostr(linuxerror));
261 end;
262 end;
263 end;
264 {$ifndef nosignal}
265 sigprocmask(SIG_BLOCK,@blockset,nil);
266 {$endif}
267 { debugout('select complete');}
268 end;
269
270 procedure tselecteventcore.exitmessageloop;
271 begin
272 exitloopflag := true
273 end;
274
275
276
277 procedure tselecteventcore.messageloop;
278 var
279 tv ,tvnow : ttimeval ;
280 currenttimer : tltimer ;
281 selectresult:integer;
282 begin
283 {$ifndef nosignal}
284 prepsigpipe;
285 {$endif}
286 {currentsocket := firstasin;
287 if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
288 repeat
289
290 if currentsocket.state = wsconnected then currentsocket.sendflush;
291 currentsocket := currentsocket.nextasin;
292 until not assigned(currentsocket);}
293
294
295 repeat
296
297 //the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed
298 if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;
299 {fd_zero(FDSR);
300 fd_zero(FDSW);
301 currentsocket := firstasin;
302 if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed
303
304 repeat
305 if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);
306 if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);
307 if currentsocket is tlsocket then begin
308 if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);
309 end;
310 tempsocket := currentsocket;
311 currentsocket := currentsocket.nextasin;
312 if tempsocket.released then begin
313 tempsocket.free;
314 end;
315 until not assigned(currentsocket);
316 }
317 processtasks;
318 //currenttask := nil;
319 {beware}
320 //if assigned(firsttimer) then begin
321 // tv.tv_sec := maxlongint;
322 tv := tv_invalidtimebig;
323 currenttimer := firsttimer;
324 while assigned(currenttimer) do begin
325 if tv_compare(tv,currenttimer.nextts) and currenttimer.enabled then tv := currenttimer.nextts;
326 currenttimer := currenttimer.nexttimer;
327 end;
328
329
330 if tv_compare(tv,tv_invalidtimebig) then begin
331 //writeln('no timers active');
332 if exitloopflag then break;
333 { sleep(10);}
334 selectresult := doselect(nil);
335
336 end else begin
337 gettimeofday(tvnow);
338 tv_substract(tv,tvnow);
339
340 //writeln('timers active');
341 if tv.tv_sec < 0 then begin
342 tv.tv_sec := 0;
343 tv.tv_usec := 0; {0.1 sec}
344 end;
345 if exitloopflag then break;
346 { sleep(10);}
347 selectresult := doselect(@tv);
348 processtimers;
349
350 end;
351 if selectresult > 0 then processasios(fdsr,fdsw);
352 {!!!only call processasios if select has asio events -beware}
353
354 {artificial delay to throttle the number of processasios per second possible and reduce cpu usage}
355 until false;
356 end;
357
358
359 procedure tselecteventcore.rmasterset(fd : integer;islistensocket : boolean);
360 begin
361 if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
362 if fd > maxs then maxs := fd;
363 if fd_isset(fd,fdsrmaster) then exit;
364 fd_set(fd,fdsrmaster);
365
366 end;
367
368 procedure tselecteventcore.rmasterclr(fd: integer);
369 begin
370 if not fd_isset(fd,fdsrmaster) then exit;
371 fd_clr(fd,fdsrmaster);
372
373 end;
374
375
376 procedure tselecteventcore.wmasterset(fd : integer);
377 begin
378 if fd > absoloutemaxs then raise esocketexception.create('file discriptor out of range');
379 if fd > maxs then maxs := fd;
380
381 if fd_isset(fd,fdswmaster) then exit;
382 fd_set(fd,fdswmaster);
383
384 end;
385
386 procedure tselecteventcore.wmasterclr(fd: integer);
387 begin
388 if not fd_isset(fd,fdswmaster) then exit;
389 fd_clr(fd,fdswmaster);
390 end;
391
392 procedure tselecteventcore.setfdreverse(fd : integer;reverseto : tlasio);
393 begin
394 fdreverse[fd] := reverseto;
395 end;
396
397 var
398 inited:boolean;
399
400 procedure lcoreinit;
401 begin
402 if inited then exit;
403 inited := true;
404 eventcore := tselecteventcore.create;
405
406 absoloutemaxs := absoloutemaxs_select;
407
408 maxs := 0;
409 fd_zero(fdsrmaster);
410 fd_zero(fdswmaster);
411 end;
412
413 end.

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22