1 unit ini;
2 {$i-}
3
4
5 interface
6
7 {$ifdef __GPC__}
8 {$x+}
9 uses fparser,utils,erweiter,gpcstrings,log,gpcsmapi,memman,fconf,fidoconf2;
10 {$endif}
11
12 {$ifdef fpc}
13 {$ifdef linux}
14 uses fparser,utils,erweiter,strings,log,smapi,memman,fconf,fidoconf2;
15 {$define havedosunit}
16 {$endif}
17 {$endif}
18
19
20
21 procedure readini(filename:string;fc:ps_fidoconfig);
22
23 type
24 paction=^taction;
25 pliste=^tliste;
26 pmask=^tmask;
27 tmask=record
28 maskname:string[50];
29 search: pfparserknoten;
30 action:paction;
31 hits:longint;
32 next:pmask;
33 end;
34 taction=record
35 action:byte;
36 spe:word;
37 msgbase:pchar;
38 addr:netaddr;
39 filename:string;
40 seenby:string;
41 dostat:pmask;
42 str:String;
43 next:paction;
44 end;
45 tliste=record
46 msgbase:pchar;
47 mask:pmask;
48 next:pliste;
49 end;
50 type
51 tparafkt=function(s:string;x:paction;y:ps_fidoconfig):boolean;
52 tini_=record a:word; s:string; need:word; can:word; end;
53 tpara_=record p:tparafkt; s:string; v:word; end;
54 tspe_=record a:word; v:word; s:string; para:word; end;
55
56
57 const
58 actionCOPY_=1;
59 actionREWRITE_=2;
60 actionMOVE_=3;
61 actionDEL_=4;
62 actionECHOCOPY_=5;
63 actionECHOMOVE_=6;
64 actionEXPORTMSG_=7;
65 actionEXPORTHEADER_=8;
66 actionSEMAPHORE_=9;
67 actionBounce_=10;
68 actionwritetofile_=11;
69
70 {actionBounce}
71 actionBounceFullMessage=1;
72 {actionRewrite}
73 actionRewriteSubj=1;
74 actionRewriteFromName=2;
75 actionRewriteToName=3;
76 actionRewriteFromAddr=4;
77 actionRewriteToAddr=5;
78
79
80 needfile=1;
81 needmb=2;
82 needaddr=4;
83 needseenby=8;
84 needdo=16;
85 needtext=32;
86
87 paranone=1;
88 paraaddr=2;
89 parastring=3;
90
91 const
92 liste:pliste=nil;
93
94
95
96 implementation
97 function dostatment(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
98 function msgbase(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
99 function addr(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
100 function testfile(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
101 function seenby(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
102 function textstatment(s:string;p:paction;fc:ps_fidoconfig):boolean;forward;
103
104 const
105 spe_:array[1..6] of tspe_=(
106 (a:actionbounce_;v:actionBounceFullMessage;s:'FULLMSG';para:paranone),
107 (a:actionrewrite_;v:actionrewritesubj;s:'SUBJ=';para:parastring),
108 (a:actionrewrite_;v:actionrewritefromname;s:'FROM=';para:parastring),
109 (a:actionrewrite_;v:actionrewritetoname;s:'TO=';para:parastring),
110 (a:actionrewrite_;v:actionrewritefromaddr;s:'ORIG=';para:paraaddr),
111 (a:actionrewrite_;v:actionrewritetoaddr;s:'DEST=';para:paraaddr)
112 );
113
114 ini_:array[1..11] of tini_=(
115 (a:actionECHOCOPY_;s:'ECHOCOPY';need:needmb+needaddr+needseenby;can:needdo),
116 (a:actionECHOMOVE_;s:'ECHOMOVE';need:needmb+needaddr+needseenby;can:needdo),
117 (a:actionBounce_;s:'BOUNCE';need:needfile+needaddr;can:needdo+needmb),
118 (a:actionMove_;s:'MOVE';need:needmb;can:needdo),
119 (a:actioncopy_;s:'COPY';need:needmb;can:needdo),
120 (a:actionexportheader_;s:'EXPORTHEADER';need:needfile;can:0),
121 (a:actionexportmsg_;s:'EXPORTMSG';need:needfile;can:0),
122 (a:actiondel_;s:'DEL';need:0;can:0),
123 (a:actionSEMAPHORE_;s:'SEMAPHORE';need:needfile;can:0),
124 (a:actionREWRITE_;s:'REWRITE';need:0;can:0),
125 (a:actionwritetofile_;s:'WRITETOFILE';need:needfile+needtext;can:0)
126 );
127 para_:array[1..6] of tpara_=(
128 (p:testfile;s:'F:';v:needfile),
129 (p:Msgbase;s:'MB:';v:needmb),
130 (p:addr;s:'ADDR:';v:needaddr),
131 (p:seenby;s:'SEENBY:';v:needseenby),
132 (p:dostatment;s:'DO:';v:needdo),
133 (p:textstatment;s:'TEXT:';v:needtext)
134 );
135 type
136 stringarray=array[1..20] of string;
137
138 procedure actionInsert(var a:paction;ins:paction);
139 var
140 b:paction;
141 begin
142 if a=nil then begin
143 a:=ins;
144 end else begin
145 actionInsert(a^.next,ins);
146 end;
147 end;
148
findmasknull149 function findmask(x:String;p:pliste):pmask;
150 var
151 s:pliste;
152 t:pmask;
153 begin
154 x:=up(x);
155 s:=p;
156 findmask:=nil;
157 while s<>nil do begin
158 t:=s^.mask;
159 while t<>nil do begin
160 if x=up(t^.maskname) then begin findmask:=t; exit; end;
161 t:=t^.next;
162 end;
163 s:=s^.next;
164 end;
165 end;
166
167 procedure maskinsert(fc:ps_fidoconfig;m:pmask;msgbase:string;var p:pliste);
168 var
169 l:pliste;
170 n:pliste;
171 pm:pmask;
172 begin
173 new(n);
174 getmem(n^.msgbase,length(msgbase)+1);
175 strpCopy(n^.msgbase,msgbase);
176 if (msgbase<>'') and (getareaimp(fc,n^.msgbase)=nil) then begin logit(9,'Msgbase "'+msgbase+'" not found!'); halt; end;
177 n^.mask:=m;
178 n^.next:=nil;
179 if p=nil then begin
180 p:=n;
181 exit;
182 end;
183 l:=p;
184 while l^.next<>nil do l:=l^.next;
185 if strpas(l^.msgbase)=msgbase then begin
186 pm:=l^.mask;
187 while pm^.next<>nil do pm:=pm^.next;
188 pm^.next:=m;
189 end else begin
190 l^.next:=n;
191 end;
192 end;
193
seenbynull194 function seenby(s:string;p:paction;fc:ps_fidoconfig):boolean;
195 begin
196 seenby:=true;
197 p^.seenby:=copy(s,8,255);
198 end;
199
textstatmentnull200 function textstatment(s:string;p:paction;fc:ps_fidoconfig):boolean;
201 begin
202 textstatment:=true;
203 p^.str:=copy(s,6,255);
204 end;
205
dostatmentnull206 function dostatment(s:string;p:paction;fc:ps_fidoconfig):boolean;
207 begin
208 p^.dostat:=findmask(copy(s,4,255),liste);
209 dostatment:=p^.dostat<>nil;
210 end;
211
testfilenull212 function testfile(s:string;p:paction;fc:ps_fidoconfig):boolean;
213 begin
214 testfile:=true;
215 p^.filename:=copy(s,3,255);
216 end;
217
msgbasenull218 function msgbase(s:string;p:paction;fc:ps_fidoconfig):boolean;
219 var
220 area:ps_area;
221 begin
222 getmem(p^.msgbase,length(copy(s,4,255))+1);
223 StrPCopy(p^.msgbase,copy(s,4,255));
224 area:=getareaimp(fc,p^.msgbase);
225 if area=nil then begin
226 writeln('Msgbase "',p^.msgbase,'" not found');
227 halt;
228 end;
229 msgbase:=true;
230 end;
231
addrnull232 function addr(s:string;p:paction;fc:ps_fidoconfig):boolean;
233 begin
234 addr:=string2addr(copy(s,6,255),p^.addr);
235 end;
236
237
238 procedure split(s:String;var x:Stringarray);
239 var
240 i:byte;
241 a,b:integer;
242 t:string;
243 begin
244 t:=s;
245 fillchar(x,sizeof(x),0);
246 for i:=1 to 20 do begin
247 s:=killspaceae(s)+' ';
248 a:=pos(' ',s)-1; if a=-1 then a:=30000;
249 b:=pos('"',s)-1; if b=-1 then b:=30000;
250 if a<b then begin
251 x[i]:=copy(s,1,pos(' ',s)-1);
252 delete(s,1,pos(' ',s));
253 end else begin
254 x[i]:=copy(s,1,pos('"',s));
255 delete(s,1,pos('"',s));
256 if (pos('"',s)=0) then begin writeln(t); writeln('" missing'); halt; end;
257 x[i]:=x[i]+copy(s,1,pos('"',s));
258 delete(s,1,pos('"',s));
259 end;
260 end;
261 end;
262
foundactionnull263 function foundaction(s:string):word;
264 var
265 i:word;
266 begin
267 s:=up(s);
268 for i:=low(ini_) to high(ini_) do begin
269 if ini_[i].s=s then begin foundaction:=i; exit; end;
270 end;
271 foundaction:=0;
272 end;
273
foundspenull274 function foundspe(var x:word;s:string;var a:paction):boolean;
275 var
276 i,j:word;
277
278 begin
279 for i:=low(spe_) to high(spe_) do begin
280 if spe_[i].a<>ini_[x].a then continue;
281 if up(copy(s,1,length(spe_[i].s)))=spe_[i].s then begin
282 delete(s,1,length(spe_[i].s));
283 a^.spe:=a^.spe or spe_[i].v;
284 case spe_[i].para of
285 parastring:begin a^.str:=s; foundspe:=true; exit; end;
286 paranone:begin foundspe:=true; exit; end;
287 paraaddr:begin foundspe:=string2addr(s,a^.addr); exit; end;
288 end
289 end;
290 end;
291 foundspe:=false;
292 end;
293
foundparanull294 function foundpara(s:string):word;
295 var
296 i:word;
297 begin
298 s:=up(s);
299 for i:=low(para_) to high(para_) do begin
300 if para_[i].s=copy(s,1,length(para_[i].s)) then begin foundpara:=i; exit; end;
301 end;
302 foundpara:=0;
303 end;
304
305 procedure readini(filename:string;fc:ps_fidoconfig);
306 type
307 tarea_array=array[1..maxint] of area;
308 Parea_array=^tarea_array;
309 const
310 inmask:boolean=false;
311 msgbase:string='';
312 var
313 f:Text;
314 s,t:String;
315 i:word;
316 p:pmask;
317 a:paction;
318 x:stringarray;
319 line:word;
320 found:word;
321 need:word;
322 can:word;
323 para:word;
324 tmp:pmask;
325 begin
326 assign(f,filename);
327 reset(f);
328 if ioresult<>0 then begin logit(9,filename+' not found'); halt; end;
329 line:=0;
330 p:=nil;
331 while not eof(f) do begin
332 readln(f,s); inc(line);
333 if ioresult<>0 then begin logit(9,'Error while reading ffma.ini'); halt; end;
334 s:=killspaceae(s);
335 if s='' then continue;
336 if s[1]='#' then continue;
337 if s[1]=';' then continue;
338 if up(copy(s,1,7))='MSGBASE' then begin
339 if not inmask then begin logit(9,'Line '+z2s(line)+' BeginMask missing'); halt; end;
340 msgbase:=killspaceae(copy(s,8,256));
341 continue;
342 end;
343 if up(copy(s,1,9))='BEGINMASK' then begin
344 if inmask then begin logit(9,'Line '+z2s(line)+' endMask missing'); halt; end;
345 new(p);
346 p^.hits:=0;
347 p^.maskname:=killspaceae(copy(s,10,255));
348 if p^.maskname='' then begin logit(9,'Line '+z2s(line)+' Maskname missing'); halt; end;
349 if findmask(p^.maskname,liste)<>nil then begin logit(9,'Line '+z2s(line)+' Maskname '+p^.maskname+' already used'); halt; end;
350 p^.search:=nil;
351 p^.action:=nil;
352 p^.next:=nil;
353 logit(2,'Reading Mask: '+p^.maskname);
354 inmask:=true;
355 continue;
356 end;
357 if up(copy(s,1,7))='ENDMASK' then begin
358 if p=nil then begin logit(9,'Sorry. You found a bug in FFMA: READINI ENDMASK'); halt; end;
359 if not inmask then begin logit(9,'Line '+z2s(line)+' BeginMask missing'); halt; end;
360 if not ((msgbase='') and (p^.search=nil)) then begin
361 if msgbase='' then begin logit(9,'Line '+z2s(line)+' MsgBase missing'); halt; end;
362 if p^.search=nil then begin logit(9,'Line '+z2s(line)+' Search missing'); halt; end;
363 end;
364 { if msgbase='*' then begin
365
366 end else begin}
367 maskinsert(fc,p,msgbase,liste);
368 { end;}
369 inmask:=false;
370 msgbase:='';
371 continue;
372 end;
373 if up(copy(s,1,7))='SEARCH ' then begin
374 if not inmask then begin logit(9,'Line '+z2s(line)+' beginMask missing'); halt; end;
375 t:=copy(s,8,256);
376 if up(t)<>'NONE' then begin
377 logit(2,'To search '+t+'<<');
378 parser(t,p^.search);
379 if p^.search=nil then begin logit(9,'in line '+s); halt; end;
380 end else begin
381 p^.search:=nil;
382 end;
383 continue;
384 end;
385 split(s,x);
386 if (up(x[1])<>'ACTION') then begin logit(9,'Line '+z2s(line)+': Unknown Command: '+x[1]); halt; end;
387 found:=foundaction(x[2]);
388 if (found=0) then begin logit(9,'Line '+z2s(line)+': Unknown Command: '+x[2]); halt; end;
389 new(a); fillchar(a^,sizeof(a^),0);
390 a^.action:=ini_[found].a;
391 need:=ini_[found].need;
392 can:=ini_[found].can;
393 for i:=3 to 20 do begin
394 if x[i]='' then continue;
395 para:=foundpara(x[i]);
396 {Parameter not found -> Spezial?}
397 if para=0 then begin
398 if foundspe(found,x[i],a) then begin
399 continue;
400 end else begin
401 logit(9,'Error in Line '+z2s(line)+': '+x[i]); halt;
402 end;
403 end;
404 {Parameter found}
405 if para_[para].p(x[i],a,fc) then begin
406 if (para_[para].v and need)<>0 then begin
407 need:=need and not para_[para].v;
408 continue;
409 end;
410 if (para_[para].v and can)=0 then begin logit(9,'Parameter useless. Line '+z2s(line)+': '+x[i]); halt; end;
411 can:=can and not para_[para].v;
412 end else begin
413 logit(9,'Error in Parameter '+z2s(line)+': '+x[i]); halt;
414 end;
415 end; {FOR}
416 if need<>0 then begin
417 logit(9,'Parameter missing in line '+z2s(line)); halt;
418 end;
419 actionInsert(p^.action,a);
420 continue;
421 end;
422 if inmask then begin logit(9,'Endmask missing'); halt; end;
423 end;
424
425 end.
426