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

Annotation of /trunk/lcoreselect.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (hide annotations)
Fri Dec 26 19:17:00 2008 UTC (10 years, 8 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 plugwash 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 plugwash 10
10     {$ifdef fpc}
11     {$ifndef ver1_0}
12     {$define useinline}
13     {$endif}
14 beware 2 {$endif}
15 plugwash 1
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 beware 20 procedure lcoreinit;
35    
36 plugwash 1 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 beware 2
47     const
48     absoloutemaxs_select = (sizeof(fdset)*8)-1;
49    
50 plugwash 1 var
51 beware 2 fdreverse:array[0..absoloutemaxs_select] of tlasio;
52 plugwash 1 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 plugwash 10
219 plugwash 1 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 plugwash 10
228    
229 plugwash 1 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 beware 20 var
398     inited:boolean;
399 plugwash 1
400 beware 20 procedure lcoreinit;
401 plugwash 1 begin
402 beware 20 if inited then exit;
403     inited := true;
404 plugwash 1 eventcore := tselecteventcore.create;
405    
406 beware 2 absoloutemaxs := absoloutemaxs_select;
407    
408 plugwash 1 maxs := 0;
409     fd_zero(fdsrmaster);
410     fd_zero(fdswmaster);
411 beware 20 end;
412    
413 plugwash 1 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