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