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