1 unit match;
2
3 interface
4
5 {$ifdef __GPC__}
6 {$x+}
7 uses fparser,gpcsmapi,erweiter,utils,memman,gpcstrings;
8 {$endif}
9
10 {$ifdef fpc}
11 {$ifdef linux}
12 uses fparser,smapi,erweiter,utils,memman,strings,log;
13 {$endif}
14 {$endif}
15
match_null16 function match_(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x: pfparserknoten):boolean;
17
18 implementation
19
20 type
arnull21 matchfkt=function(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
22
23 function mstr(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
24 function mflag(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
25 function mbody(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
26 function mkludge(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
27 function mzahl(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
28 function maddr(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;forward;
29
30 const
31 {$ifdef __GPC__}
32 { **************STATIC TEXT********************************************************************
33 SUB TO Orig LEN **********ORIG******** **********DEST********
34 Str Zahl ADDR FLAGS FROM Body Dest Zone NET NODE PONT Zone NET NODE PONT Flag }
35 m:array[0..21,0..21] of matchfkt=
36 (
37 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil) ),
38 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , mstr ,mstr ,mstr ,mbody,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil) ), {String}
39 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {Zahl}
40 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,maddr,maddr,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mflag,matchfkt(nil)), {ADDR}
41 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mbody,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil) ,matchfkt(nil)), {Flags}
42
43 (matchfkt(nil) ,mstr ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {SUBJ}
44 (matchfkt(nil) ,mstr ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {FROM}
45 (matchfkt(nil) ,mstr ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {TO}
46 (matchfkt(nil) ,mbody,matchfkt(nil) ,matchfkt(nil) ,mbody, matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {BODY}
47 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,maddr,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,maddr,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {ORIG}
48
49 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,maddr,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,maddr,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {DEST}
50 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {LEN}
51 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {OZONE}
52 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {ONET}
53 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {ONODE}
54
55 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {OZONE}
56 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {DZONE}
57 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {DNET}
58 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {DNODE}
59 (matchfkt(nil) ,matchfkt(nil) ,mzahl,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,matchfkt(nil),matchfkt(nil)), {DZONE}
60
61 (matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,mflag , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)), {Flag }
62 (matchfkt(nil) ,mkludge , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) , matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil) ,matchfkt(nil),matchfkt(nil)) {Flag }
63 );
64 {$else}
65 { **************STATIC TEXT********************************************************************
66 SUB TO Orig LEN **********ORIG******** **********DEST********
67 Str Zahl ADDR FLAGS FROM Body Dest Zone NET NODE PONT Zone NET NODE PONT Flag }
68 m:array[0..21,0..21] of matchfkt=
69 (
70 (nil ,nil ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ),
71 (nil ,nil ,nil ,nil ,nil , mstr ,mstr ,mstr ,mbody,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil , nil ), {String}
72 (nil ,nil ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {Zahl}
73 (nil ,nil ,nil ,nil ,nil , nil ,nil ,nil ,nil ,maddr,maddr,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,mflag, nil ), {ADDR}
74 (nil ,nil ,nil ,nil ,nil , nil ,nil ,nil ,mbody,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {Flags}
75
76 (nil ,mstr ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, mkludge ), {SUBJ}
77 (nil ,mstr ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {FROM}
78 (nil ,mstr ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {TO}
79 (nil ,mbody,nil ,nil ,mbody, nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {BODY}
80 (nil ,nil ,nil ,maddr,nil , nil ,nil ,nil ,nil ,nil ,maddr,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {ORIG}
81
82 (nil ,nil ,nil ,maddr,nil , nil ,nil ,nil ,nil ,maddr,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {DEST}
83 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil ), {LEN}
84 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {OZONE}
85 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {ONET}
86 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {ONODE}
87
88 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {OZONE}
89 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {DZONE}
90 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {DNET}
91 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {DNODE}
92 (nil ,nil ,mzahl,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,mzahl,nil, nil ), {DZONE}
93
94 (nil ,nil ,nil ,nil ,mflag , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil), {Flag }
95 (nil ,mkludge ,nil ,nil ,nil , nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil ,nil, nil) {Flag }
96 );
97 {$endif}
98 flags:array[1..12] of record s:String; x:word; end=
99 ((s:'PRIVATE';x:1),
100 (s:'CRASH';x:$2),
101 (s:'READ';x:$4),
102 (s:'SENT';x:$8),
103 (s:'FILE';x:$10),
104 (s:'FWD';x:$20),
105 (s:'ORPHAN';x:$40),
106 (s:'KILL';x:$80),
107 (s:'LOCAL';x:$100),
108 (s:'HOLD';x:$200),
109 (s:'FRQ';x:$800),
110 (s:'URQ';x:$8000)
111 );
getflagnull112 function getflag(s:string):word;
113 var
114 i:word;
115 begin
116 getflag:=0;
117 for i:=low(flags) to high(flags) do begin
118 if flags[i].s=up(s) then getflag:=flags[i].x;
119 end;
120 end;
121
getnull122 function get(s:String;area:pharea;msg:phmsg;xmsg:pxmsg;x:pfparserknoten):string;
123 var
124 d:netaddr;
125 begin
126 if (s[1]='"') and (s[length(s)]='"') then begin
127 delete(s,1,1); delete(s,length(s),1);
128 get:=s; exit;
129 end;
130 if s='SUBJ' then begin get:=array2string(xmsg^.subj,72); exit; end;
131 if s='FROM' then begin get:=array2string(xmsg^.fromname,36); exit; end;
132 if s='TO' then begin get:=array2string(xmsg^.toname,36); exit; end;
133 if s='DEST' then begin get:=showaddr(xmsg^.dest); exit; end;
134 if s='ORIG' then begin get:=showaddr(xmsg^.orig); exit; end;
135 if s='LEN' then begin get:=z2s(area^.f^.GetTextLen(msg)); exit; end;
136
137 if S='OZONE' then begin get:=z2s(xmsg^.orig.zone); exit; end;
138 if S='ONODE' then begin get:=z2s(xmsg^.orig.node); exit; end;
139 if S='ONET' then begin get:=z2s(xmsg^.orig.net); exit; end;
140 if S='OPOINT' then begin get:=z2s(xmsg^.orig.point); exit; end;
141 if S='DZONE' then begin get:=z2s(xmsg^.dest.zone); exit; end;
142 if S='DNODE' then begin get:=z2s(xmsg^.dest.node); exit; end;
143 if S='DNET' then begin get:=z2s(xmsg^.dest.net); exit; end;
144 if S='DPOINT' then begin get:=z2s(xmsg^.dest.point); exit; end;
145 writeln('MatchError: ',s); halt;
146 end;
147
idnull148 function id(s:String):word;
149 var
150 i:word;
151 x:longint;
152 a:netaddr;
153 begin
154 if (s[1]='"') and (s[length(s)]='"') then begin
155 delete(s,1,1); delete(s,length(s),1);
156 val(s,x,i);
157 if i=0 then begin id:=2; exit; end;
158 if string2addr(s,a) then begin id:=3; exit; end;
159 if getflag(s)>0 then begin id:=4; exit; end;
160 id:=1;
161 exit;
162 end;
163 for i:=low(symbole) to high(symbole) do begin
164 if s=symbole[i] then begin id:=i; exit; end;
165 end;
166 writeln('Can not handle: ',s); halt;
167 end;
168
mflagnull169 function mflag(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
170 var
171 not_:boolean;
172 fl:word;
173 att:longint;
174 myflag:longint;
175 begin
176 mflag:=false;
177 if not (x^.ele[1] in ['=','%']) then begin
178 writeln('Error: ',x^.ele,' not supported in flag-statment'); halt;
179 end;
180 att:=xmsg^.attr;
181 if up(x^.l^.ele)='FLAG' then begin
182 myflag:=getflag(get(x^.r^.ele,area,msg,xmsg,x));
183 end else begin
184 myflag:=getflag(get(x^.l^.ele,area,msg,xmsg,x));
185 end;
186 if x^.ele='=' then mflag:=(att and myflag)<>0;
187 if x^.ele='%' then mflag:=(att and myflag)=0;
188 end;
189
mbodynull190 function mbody(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
191 var
192 s:string;
193 not_:boolean;
194 i,textsize:longint;
195 ppp,p,pp:pchar;
196 b:boolean;
197 begin
198 not_:=false;
199 if x^.ele<>'=' then begin
200 writeln('Error: ',x^.ele,' not supported in body-statment'); halt;
201 end;
202 if x^.r^.ele='BODY' then begin
203 s:=get(x^.l^.ele,area,msg,xmsg,x);
204 end else begin
205 s:=get(x^.r^.ele,area,msg,xmsg,x);
206 end;
207 if (length(s)>0) and (s[1]='!') then begin not_:=true; delete(s,1,1); end;
208 if (length(s)>0) and (s[1]='~') then begin writeln('~ not neccessary in body-statment'); delete(s,1,1); end;
209 textsize:=area^.f^.GetTextLen(msg);
210 if textsize=0 then begin mbody:=false; exit; end;
211
212 p:=getmemory(textsize+1);
213 area^.f^.ReadMsg(msg,xmsg,0,textsize,p,0,nil);
214 p[textsize]:=#0;
215
216 pp:=getmemory(length(s)+1);
217 strpcopy(pp,s);
218
219 b:=psearchi(p,pp)<>nil;
220 if not_ then b:=not b;
221 mbody:=b;
222 freememory(p,true);
223 freememory(pp,true);
224 end;
225
mkludgenull226 function mkludge(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
227 var
228 s:string;
229 not_:boolean;
230 i,ctrlsize:longint;
231 ppp,p,pp:pchar;
232 b:boolean;
233 F:file;
234 begin
235 not_:=false;
236 if x^.ele<>'=' then begin
237 writeln('Error: ',x^.ele,' not supported in kludge-statment'); halt;
238 end;
239 if x^.r^.ele='KLUDGE' then begin
240 s:=get(x^.l^.ele,area,msg,xmsg,x);
241 end else begin
242 s:=get(x^.r^.ele,area,msg,xmsg,x);
243 end;
244 if (length(s)>0) and (s[1]='!') then begin not_:=true; delete(s,1,1); end;
245 if (length(s)>0) and (s[1]='~') then begin writeln('~ not neccessary in kludge-statment'); delete(s,1,1); end;
246 ctrlsize:=area^.f^.GetCtrlLen(msg);
247 if ctrlsize=0 then begin mkludge:=false; exit; end;
248
249 p:=getmemory(ctrlsize+1);
250 area^.f^.ReadMsg(msg,xmsg,0,0,nil,ctrlsize,p);
251 p[ctrlsize]:=#0;
252
253 pp:=getmemory(length(s)+1);
254 strpcopy(pp,s);
255
256 b:=psearchi(p,pp)<>nil;
257 if not_ then b:=not b;
258 mkludge:=b;
259 freememory(p,true);
260 freememory(pp,true);
261 end;
262
maddrnull263 function maddr(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
264 var
265 s,t:string;
266 b:boolean;
267 a:netaddr;
268 begin
269 if not (x^.ele[1] in ['=','%']) then begin
270 writeln('Error: ',x^.ele,' not supported in ORIG or DEST statment'); halt;
271 end;
272 s:=up(get(x^.l^.ele,area,msg,xmsg,x));
273 string2addr(s,a); s:=showaddr(a);
274 t:=up(get(x^.r^.ele,area,msg,xmsg,x));
275 string2addr(t,a); t:=showaddr(a);
276 case x^.ele[1] of
277 '=':b:=s=t;
278 '%':b:=s<>t;
279 end;
280 maddr:=b;
281 end;
282
mzahlnull283 function mzahl(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
284 var
285 s,t:string;
286 b:boolean;
287 begin
288 s:=up(get(x^.l^.ele,area,msg,xmsg,x));
289 t:=up(get(x^.r^.ele,area,msg,xmsg,x));
290 case x^.ele[1] of
291 '=':b:=s2z(s)=s2z(t);
292 '<':b:=s2z(s)<s2z(t);
293 '>':b:=s2z(s)>s2z(t);
294 '%':b:=s2z(s)<>s2z(t);
295 end;
296 mzahl:=b;
297 end;
298
mstrnull299 function mstr(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
300 var
301 s,t:string;
302 sub_,not_:boolean;
303 b,lsub,rsub:boolean;
304 begin
305 s:=up(get(x^.l^.ele,area,msg,xmsg,x));
306 t:=up(get(x^.r^.ele,area,msg,xmsg,x));
307 sub_:=false; not_:=false; lsub:=false; rsub:=false;
308 if (length(s)>0) and (s[1]='!') then begin not_:=true; delete(s,1,1); end;
309 if (length(s)>0) and (s[1]='~') then begin sub_:=true; lsub:=true; delete(s,1,1); end;
310 if (length(t)>0) and (t[1]='!') then begin not_:=true; delete(t,1,1); end;
311 if (length(t)>0) and (t[1]='~') then begin sub_:=true; rsub:=true; delete(t,1,1); end;
312 if ((x^.ele[1] in ['<','>']) and sub_) or (rsub and lsub) then begin
313 writeln('Error: '+x^.l^.ele+x^.ele+x^.r^.ele); halt
314 end;
315 if ((x^.ele[1] in ['<','>','%']) and sub_) or (rsub and lsub) then begin
316 writeln('Error: '+x^.l^.ele+x^.ele+x^.r^.ele); halt
317 end;
318 b:=false;
319 case x^.ele[1] of
320 '<':b:=s<t;
321 '>':b:=s>t;
322 '%':b:=s<>t;
323 '=':if sub_ then begin
324 if lsub then begin
325 b:=pos(s,t)>0;
326 end else begin
327 b:=pos(t,s)>0;
328 end;
329 end else begin
330 b:=s=t;
331 end;
332 end;
333 if not_ then b:=not b;
334 mstr:=b;
335 end;
336
337
match_null338 function match_(var area:pharea;var msg:phmsg;var xmsg:pxmsg;x:pfparserknoten):boolean;
339 var
340 p:pointer;
341 c,b:boolean;
342 begin
343 match_:=false;
344 if x=nil then begin
345 writeln('ERROR: x=nil in match_');
346 halt;
347 end;
348 if x^.ele[1] in ['|','&'] then begin
349 b:=match_(area,msg,xmsg,x^.l);
350 c:=match_(area,msg,xmsg,x^.r);
351 case x^.ele[1] of
352 '|':match_:=c or b;
353 '&':match_:=c and b;
354 else begin
355 writeln('Error: '+x^.l^.ele+x^.ele+x^.r^.ele); halt;
356 end;
357 end;
358 exit;
359 end;
360 if not assigned(m[id(x^.l^.ele),id(x^.r^.ele)]) then begin
361 writeln('Can not handle ('+z2s(id(x^.l^.ele))+':'+z2s(id(x^.r^.ele))+'): '+x^.l^.ele+x^.ele+x^.r^.ele); halt;
362 end else begin
363 match_:=m[id(x^.l^.ele),id(x^.r^.ele)](area,msg,xmsg,x);
364 end;
365 end;
366
367 end.
368