1 program ffma;
2 {
3 FFMA FreeFidoMessageAssistant
4
5 Copyright (C) 1998-2000 Sven Bursch
6
7 Fido: 2:2448/820
8 Internet: sb100@uni-duisburg.de
9
10 This program is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or
13 (at your option) any later version.
14
15 This program is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with this program; if not, write to the Free Software
22 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23
24
25 }
26
27 {$ifdef __GPC__}
28 {$x+}
29 Uses ini,erweiter,gpcstrings,utils,fparser,memman,log,gpcsmapi,match,fconf,fidoconf2;
30 {$endif}
31
32 {$ifdef fpc}
33 {$ifdef linux}
34 Uses crt,dos,ini,erweiter,strings,utils,fparser,memman,log,smapi,match,fconf,fidoconf2;
35 {$endif}
36 {$endif}
37
38
39 const
40 configfile:string='/etc/fido/ffma.ini';
41 version='0.08.01';
42 compiler:string='Unknown';
43
44 type
45 fileuid=record msgbase:String; uid:longint; end;
46 puid=^tuid;
47 tuid=record
48 msgbase:string;
49 uid:longint;
50 next:puid;
51 end;
52 const
53 uidliste:puid=nil;
54 uidlisteout:puid=nil;
55 ffmauid:string='';
56
57 var
58 fc:ps_fidoconfig;
59 para:record
60 debug:boolean;
61 help:boolean;
62 scanall:boolean;
63 scannew:boolean;
64 saveuid:boolean;
65 test:boolean;
66
67 save:boolean;
68 end;
69
uniqfilenamenull70 function uniqfilename(path:string):string;
71 const
72 conv:string='0123456789ABCDEF';
73
74 var
75 i:word;
76 name:string;
77 begin
78 repeat
79 name:=path+'/';
80 for i:=1 to 8 do name:=name+conv[random(16)+1];
81 until not exist(name);
82 uniqfilename:=name;
83 end;
84
isdirnull85 function isdir(s:string):boolean;
86 var
87 dir:searchrec;
88 begin
89 FindFirst(s, anyfile, Dir);
90 isdir:=(doserror=0) and ((dir.attr and $10)=$10);
91 end;
92
93 procedure storeuid(var l:puid;msgbase:string;uid:longint);
94 begin
95 if l=nil then begin
96 new(l);
97 fillchar(l^,sizeof(l),0);
98 l^.msgbase:=msgbase;
99 l^.uid:=uid;
100 l^.next:=nil;
101 exit;
102 end;
103 if l^.msgbase=msgbase then begin
104 l^.uid:=uid;
105 exit;
106 end;
107 storeuid(l^.next,msgbase,uid);
108 end;
109
110 procedure removeuid(var l:puid;msgbase:string);
111 var
112 x:puid;
113 begin
114 if l=nil then exit;
115 if l^.msgbase=msgbase then begin
116 x:=l;
117 l:=l^.next;
118 dispose(x);
119 exit;
120 end;
121 removeuid(l^.next,msgbase);
122 end;
123
124 procedure writeuidtofile(l:puid);
125 var
126 x:fileuid;
127 f:file of fileuid;
128 err:integer;
129 begin
130 {$i-}
131 logit(1,'Entering WriteUidToFile');
132 assign(f,ffmauid);
133 {$ifdef __GPC__}
134 rewrite(f);
135 {$else}
136 rewrite(f,1);
137 {$endif}
138 err:=ioresult;
139 if err<>0 then begin logit(9,'Error while opening '+ffmauid+': '+geterrortext(err)); halt; end;
140 while l<>nil do begin
141 fillchar(x,sizeof(x),0);
142 x.msgbase:=l^.msgbase;
143 x.uid:=l^.uid;
144 logit(1,'Saving: Msgbase: '+l^.msgbase+' UID: '+z2s(l^.uid));
145 write(f,x);
146 err:=ioresult;
147 if err<>0 then begin logit(9,'Error while writing '+ffmauid+': '+geterrortext(err)); halt; end;
148 l:=l^.next;
149 end;
150 close(f);
151 err:=ioresult;
152 if err<>0 then begin logit(9,'Error while closing '+ffmauid+': '+geterrortext(err)); halt; end;
153 logit(1,'Leaving WriteUidToFile');
154 end;
155
156 procedure loaduid;
157 var
158 x:fileuid;
159 f:file of fileuid;
160 io:word;
161 begin
162 assign(f,ffmauid);
163 {$ifdef __GPC__}
164 reset(f);
165 {$else}
166 reset(f,1);
167 {$endif}
168 io:=ioresult;
169 if io=2 then exit;
170 if io<>0 then begin
171 logit(9,'Can not read File `'+ffmauid+'`');
172 halt;
173 end;
174 while not eof(f) do begin
175 read(f,x);
176 storeuid(uidliste,x.msgbase,x.uid);
177 end;
178 close(f);
179 end;
180
getuidnull181 function getuid(msgbase:string;var uid:longint):boolean;
182 var
183 l:puid;
184 begin
185 getuid:=false;
186 l:=uidliste;
187 while l<>nil do begin
188 if l^.msgbase=msgbase then begin uid:=l^.uid; getuid:=true; exit; end;
189 l:=l^.next;
190 end;
191 end;
192
193 procedure doaction(p:paction;fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;var num:longint;var del:boolean);forward;
194
195 procedure dodostatment(fcarea:ps_area;area:pharea;nr:longint;mask:pmask);
196 var
197 del:boolean;
198 msg:phmsg;
199 xmsg:pxmsg;
200 begin
201 del:=false;
202 logit(4,'Message '+z2s(nr)+' -> '+mask^.maskname);
203 msg:=area^.f^.OpenMsg(area,MOPEN_READ,nr);
204 new(xmsg);
205 area^.f^.ReadMsg(msg,xmsg,0,0,nil,0,nil);
206 doaction(mask^.action,fcarea,area,msg,xmsg,nr,del);
207 area^.f^.closemsg(msg);
208 if del then begin
209 logit(4,'Deleting Message '+z2s(nr));
210 if area^.f^.KillMsg(area,nr) <>0 then begin writeln('Could not delete Message Nr.',nr); halt; end;
211 end;
212 dispose(xmsg);
213 end;
214
215
216 procedure actionSEMAPHORE(var ziel:String);
217 var
218 f:file;
219 c:char;
220 begin
221 assign(f,ziel);
222 if not exist(ziel) then begin
223 rewrite(f);
224 end else begin
225 {$ifdef __GPC__}
226 reset(f);
227 {$else}
228 reset(f,1);
229 {$endif}
230 if not eof(f) then begin seek(f,0); blockread(f,c,1); seek(f,0); blockwrite(f,c,1); end;
231 end;
232 close(f);
233 end;
234
235 procedure actioncopy(farea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;p:paction);
236 var
237 destarea:pharea;
238 destmsg:phmsg;
239 destfcarea:ps_area;
240
241 ctrlbuf,textbuf:pchar;
242 ctrlsize,textsize:longint;
243 newnr:longint;
244 begin
245 destfcarea:=getareaimp(fc,p^.msgbase);
246 if destfcarea=nil then begin
247 writeln('Could not open Msgbase: ',p^.msgbase); halt;
248 end;
249 destarea:=MsgOpenArea(destfcarea^.filename,MSGAREA_CRIFNEC,destfcarea^.msgbtype);
250 if destarea=nil then begin
251 writeln('Could not open Msgbase: ',p^.msgbase); halt;
252 end;
253 while destarea^.f^.lock(destarea)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
254
255 if InvalidMh(destarea) then begin
256 writeln('Invalid handle to Msgbase');
257 halt;
258 end;
259
260 textsize:=area^.f^.GetTextLen(msg);
261 ctrlsize:=area^.f^.GetCtrlLen(msg);
262 textbuf:=getmemory(textsize+1);
263 ctrlbuf:=getmemory(ctrlsize+1);
264 area^.f^.ReadMsg(msg,xmsg,0,textsize,textbuf,ctrlsize,ctrlbuf);
265 destmsg:=destarea^.f^.OpenMsg(destarea,MOPEN_CREATE,0);
266 newnr:=destarea^.high_msg+1;
267 destarea^.f^.WriteMsg(destmsg,0,xmsg,textbuf,textsize,textsize,ctrlsize,ctrlbuf);
268 destarea^.f^.closemsg(destmsg);
269 freememory(textbuf,true);
270 freememory(ctrlbuf,true);
271 if p^.dostat<>nil then dodostatment(destfcarea,destarea,newnr,p^.dostat);
272 while destarea^.f^.unlock(destarea)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
273 destarea^.f^.closearea(destarea);
274 end;
275
276 procedure actionexportheader(fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;ziel:string);
277 var
278 f:text;
279 s,t:string;
280 i:word;
281 filename:string;
282 begin
283 area^.f^.ReadMsg(msg,xmsg,0,0,nil,0,nil);
284 if isdir(ziel) then begin
285 filename:=uniqfilename(ziel);
286 end else begin
287 filename:=ziel;
288 end;
289 assign(f,filename);
290 if not exist(filename) then begin rewrite(f); close(f); end;
291 append(f);
292 if ioresult<>0 then begin writeln('Could not open ',ziel); halt; end;
293 writeln(f,asc(80,'='));
294 if ioresult<>0 then begin writeln('Could not writeto ',ziel); halt; end;
295 s:='';
296 for i:=1 to 36 do if xmsg^.fromname[i-1]=#0 then break else s:=s+xmsg^.fromname[i-1];
297 t:='From: '+s+' ('+showaddr(xmsg^.orig)+')';
298 writeln(f,t+asc(80-length(t)-20,' ')+showdatetime(xmsg^.date_written.date,xmsg^.date_written.time));
299 s:='';
300 for i:=1 to 36 do if xmsg^.toname[i-1]=#0 then break else s:=s+xmsg^.toname[i-1];
301 t:='To: '+s+' ('+showaddr(xmsg^.dest)+')';
302 writeln(f,t+asc(80-length(t)-20,' ')+showdatetime(xmsg^.date_arrived.date,xmsg^.date_arrived.time));
303 s:='';
304 for i:=1 to 72 do if xmsg^.subj[i-1]=#0 then break else s:=s+xmsg^.subj[i-1];
305 writeln(f,'Subj: ',s);
306 close(f);
307 end;
308
309 procedure actionexportmsg(fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;ziel:string);
310 var
311 textbuf:pchar;
312 textsize,i:longint;
313 f:text;
314 s,t:string;
315 filename:string;
316 begin
317 textsize:=area^.f^.GetTextLen(msg);
318 textbuf:=getmemory(textsize+1);
319 area^.f^.ReadMsg(msg,xmsg,0,textsize,textbuf,0,nil);
320 if isdir(ziel) then begin
321 filename:=uniqfilename(ziel);
322 end else begin
323 filename:=ziel;
324 end;
325 assign(f,filename);
326 if not exist(filename) then begin rewrite(f); close(f); end;
327 append(f);
328 if ioresult<>0 then begin writeln('Could not open ',ziel); halt; end;
329 writeln(f,asc(80,'='));
330 if ioresult<>0 then begin writeln('Could not writeto ',ziel); halt; end;
331 s:='';
332 for i:=1 to 36 do if xmsg^.fromname[i-1]=#0 then break else s:=s+xmsg^.fromname[i-1];
333 t:='From: '+s+' ('+showaddr(xmsg^.orig)+')';
334 writeln(f,t+asc(80-length(t)-20,' ')+showdatetime(xmsg^.date_written.date,xmsg^.date_written.time));
335 s:='';
336 for i:=1 to 36 do if xmsg^.toname[i-1]=#0 then break else s:=s+xmsg^.toname[i-1];
337 t:='To: '+s+' ('+showaddr(xmsg^.dest)+')';
338 writeln(f,t+asc(80-length(t)-20,' ')+showdatetime(xmsg^.date_arrived.date,xmsg^.date_arrived.time));
339 s:='';
340 for i:=1 to 72 do if xmsg^.subj[i-1]=#0 then break else s:=s+xmsg^.subj[i-1];
341 writeln(f,'Subj: ',s);
342 writeln(f,asc(80,'-'));
343 s:='';
344 t:='';
345 for i:=0 to textsize-1 do begin
346 if (textbuf[i]=#13) or (textbuf[i]=#1) then begin
347 if not ((length(s)>0) and (s[1]=#1)) then writeln(f,s+t);
348 s:=''; T:='';
349 if textbuf[i]=#1 then s:=#1;
350 continue;
351 end;
352 if textbuf[i]=#0 then break;
353 if textbuf[i]=' ' then begin
354 t:=t+textbuf[i];
355 if (length(s)+length(t))>80 then begin writeln(f,s); S:=''; end;
356 s:=s+t;
357 t:='';
358 continue;
359 end;
360 t:=t+textbuf[i];
361 end;
362 if not ((length(s)>0) and (s[1]=#1)) then writeln(f,s+t);
363 close(f);
364 freememory(textbuf,true);
365 end;
366
367
368 procedure actionechocopy(fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;a:paction);
369 const
370 deforigin=#$0d+'---'+#$0d+' * Origin: Default ';
371 var
372 destarea:pharea;
373 destmsg:phmsg;
374 destfcarea:ps_area;
375 ctrlbuf,textbuf:pchar;
376 ctrlsize,textsize:longint;
377 pp,ppp:pchar;
378 kludge,enter:pchar;
379 ORIGIN:pchar;
380 s:string;
381 I:longint;
382 newnr:longint;
383 begin
384 destfcarea:=getareaimp(fc,a^.msgbase);
385 if destfcarea=nil then begin
386 writeln('Could not open Msgbase via fidoconfig: ',a^.msgbase);
387 halt;
388 end;
389 destarea:=MsgOpenArea(destfcarea^.filename,MSGAREA_CRIFNEC,destfcarea^.msgbtype);
390 if destarea=nil then begin
391 writeln('Could not open Msgbase: ',a^.msgbase);
392 halt;
393 end;
394 if InvalidMh(destarea) then begin
395 writeln('Invalid handle to Msgbase');
396 halt;
397 end;
398 newnr:=destarea^.high_msg+1;
399 textsize:=area^.f^.GetTextLen(msg);
400 textbuf:=getmemory(textsize+10000);
401 ctrlbuf:=nil; ctrlsize:=0;
402 area^.f^.ReadMsg(msg,xmsg,0,textsize,textbuf,0,nil);
403 textbuf[textsize]:=#0;
404 xmsg^.orig:=a^.addr;
405 xmsg^.attr:=msglocal;
406 pp:=psearch(textbuf,#$0d+'--- ');
407 while pp<>nil do begin pp[2]:='+'; pp:=psearch(textbuf,#$0d+'--- '); end;
408
409 pp:=psearchI(textbuf,#$0d+' * Origin: ');
410 while pp<>nil do begin pp[2]:='+'; pp:=psearchI(textbuf,#$0d+' * Origin: '); end;
411
412 {Entfernung alle Kludges am Ende der Nachricht}
413 repeat
414 enter:=strrscan(textbuf,#$0d);
415 if enter=nil then break;
416 kludge:=strrscan(textbuf,#1);
417 if kludge=nil then break;
418 ppp:=strscan(kludge,#$0d);
419 if ppp=nil then break;
420 if ppp=enter then begin
421 kludge[0]:=#0;
422 end else break;
423 until false;
424
425 textsize:=strlen(textbuf)+1;
426 s:=deforigin+'('+showaddr(xmsg^.orig)+')'#13'SEEN-BY: '+a^.seenby+#13#0;
427 origin:=getmemory(length(s)+1);
428 strpcopy(origin,s);
429
430 strcat(textbuf,origin);
431
432 destmsg:=destarea^.f^.OpenMsg(destarea,MOPEN_CREATE,0);
433 destarea^.f^.WriteMsg(destmsg,0,xmsg,textbuf,strlen(textbuf),strlen(textbuf),0,ctrlbuf);
434 destarea^.f^.closemsg(destmsg);
435 freememory(textbuf,true);
436 freememory(origin,true);
437 if a^.dostat<>nil then dodostatment(destfcarea,destarea,newnr,a^.dostat);
438 destarea^.f^.closearea(destarea);
439 end;
440
createkludgesnull441 function createkludges(orig,dest:netaddr;createmsgid:boolean):pchar;
442 var
443 s:string;
444 p:pchar;
445 begin
446 s:='';
447 if createmsgid then s:=#1+'MSGID: '+z2s(orig.zone)+':'+z2s(orig.net)+'/'+z2s(orig.node)+'.'+z2s(orig.point)+' '+longint2hex(msgid);
448 s:=s+#1+'INTL '+z2s(dest.zone)+':'+z2s(dest.net)+'/'+z2s(dest.node)+' '+
449 z2s(orig.zone)+':'+z2s(orig.net)+'/'+z2s(orig.node);
450 if dest.point<>0 then begin
451 s:=s+#1+'TOPT '+z2s(dest.point);
452 end;
453 if orig.point<>0 then begin
454 s:=s+#1+'FMPT '+z2s(orig.point);
455 end;
456 p:=getmemory(length(s)+1);
457 strpcopy(p,s);
458 createkludges:=p;
459 end;
460
461 procedure eval(xmsg:pxmsg;var textsize:longint;var textbuf:pchar);
462 const
463 syb:array[1..7] of string=('TO','FR','OR','DE','SU','TI','DA');
foundnull464 function found(s:string):byte;
465 var
466 k:byte;
467 begin
468 found:=0;
469 for k:=1 to 9 do if '%'+syb[k]=s then begin found:=k; break; end;
470 end;
471
472 var
473 i,j,x:longint;
474 l:boolean;
475 s:string;
476 p,org:pchar;
477 begin
478 p:=getmemory(textsize+10000);
479 org:=textbuf;
480 x:=0;
481 l:=false;
482 S:='';
483 for i:=0 to textsize-1 do begin
484 if l then begin
485 s:=s+textbuf[i];
486 if length(s)=3 then begin
487 case found(up(s)) of
488 0: begin s:=''; end;
489 1: s:=array2string(xmsg^.toname,36);
490 2: s:=array2string(xmsg^.fromname,36);
491 3: s:=showaddr(xmsg^.orig);
492 4: s:=showaddr(xmsg^.dest);
493 5: s:=array2string(xmsg^.subj,72);
494 6: s:=showtime(xmsg^.date_written.time);
495 7: s:=showdate(xmsg^.date_written.date);
496 end;
497 for j:=1 to length(s) do begin p[x]:=s[j]; inc(x); end;
498 s:='';
499 l:=false;
500 end;
501 continue;
502 end;
503 if textbuf[i]<>'%' then begin
504 p[x]:=textbuf[i]; inc(x);
505 end else begin
506 l:=true;
507 s:='%';
508 end;
509 end;
510 if p[x]<>#0 then begin
511 p[x]:=#0; inc(x);
512 end;
513 textbuf:=p;
514 textsize:=x;
515 freememory(org,true);
516 end;
517
518
519 procedure actionbounce(fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;p:paction);
520 var
521 f:file;
522 destarea:pharea;
523 destfcarea:ps_area;
524 xmsgnew:pxmsg;
525 msgnew:phmsg;
526 textsize:longint;
527 ctrlbuf,textbuf,msgbuf:pchar;
528 destmsg:phmsg;
529 msgsize,buffersize:longint;
530 newnr:longint;
531 del:boolean;
532 begin
533 assign(f,p^.filename);
534 if not exist(P^.filename) then begin
535 logit(9,'File '+p^.filename+' not found!'); halt;
536 end;
537 {$ifdef __GPC__}
538 reset(f);
539 {$else}
540 reset(f,1);
541 {$endif}
542 textsize:=filesize(f);
543 textbuf:=getmemory(textsize+10000);
544 {Reading File}
545 blockread(f,textbuf^,filesize(f));
546 textbuf[textsize]:=#0; inc(textsize);
547 {Reading Msg-Header, creating new Header}
548 area^.f^.ReadMsg(msg,xmsg,0,0,nil,0,nil);
549 new(xmsgnew);
550 fillchar(xmsgnew^,sizeof(xmsgnew^),0);
551 xmsgnew^.fromname:=xmsg^.toname;
552 xmsgnew^.attr:=msglocal;
553 xmsgnew^.toname:=xmsg^.fromname;
554 xmsgnew^.subj:=xmsg^.subj;
555 xmsgnew^.orig:=p^.addr;
556 xmsgnew^.dest:=xmsg^.orig;
557 xmsgnew^.utc_ofs:=0;
558 datetime2ftsdate(xmsgnew^.date_written.date,xmsgnew^.date_written.time,xmsgnew^.__ftsc_date);
559 xmsgnew^.date_arrived.date:=xmsgnew^.date_written.date;
560 xmsgnew^.date_arrived.time:=xmsgnew^.date_written.time;
561 {Ersetze %?? durch Headerdaten}
562 eval(xmsg,textsize,textbuf);
563 ctrlbuf:=createkludges(xmsgnew^.orig,xmsgnew^.dest,true);
564 if (p^.msgbase=nil) or (strpas(p^.msgbase)='') then begin
565 newnr:=area^.high_msg+1;
566 destmsg:=area^.f^.OpenMsg(area,MOPEN_CREATE,0);
567 destarea:=area;
568 end else begin
569 destfcarea:=getareaimp(fc,p^.msgbase);
570 if destfcarea=nil then begin
571 writeln('Could not open Msgbase via fidoconfig: ',p^.msgbase);
572 halt;
573 end;
574 destarea:=MsgOpenArea(destfcarea^.filename,MSGAREA_CRIFNEC,destfcarea^.msgbtype);
575 if destarea=nil then begin
576 writeln('Could not open Msgbase via fidoconfig: ',p^.msgbase);
577 halt;
578 end;
579 newnr:=destarea^.high_msg+1;
580 if destarea=nil then begin
581 writeln('Could not open Msgbase: ',p^.msgbase);
582 halt;
583 end;
584 if InvalidMh(destarea) then begin
585 writeln('Invalid handle to Msgbase');
586 halt;
587 end;
588 destmsg:=destarea^.f^.OpenMsg(destarea,MOPEN_CREATE,0);
589 end;
590 if (p^.spe and actionbouncefullmessage)<>0 then begin
591 msgsize:=area^.f^.GetTextLen(msg);
592 msgbuf:=getmemory(msgsize+1);
593 area^.f^.ReadMsg(msg,nil,0,msgsize,msgbuf,0,nil);
594 destarea^.f^.WriteMsg(destmsg,0,xmsgnew,textbuf,textsize-1,textsize+msgsize,strlen(ctrlbuf),ctrlbuf);
595 destarea^.f^.WriteMsg(destmsg,1,xmsgnew,msgbuf,msgsize,textsize+msgsize,0,nil);
596 freememory(msgbuf,true);
597 end else begin
598 destarea^.f^.WriteMsg(destmsg,0,xmsgnew,textbuf,textsize,textsize,strlen(ctrlbuf),ctrlbuf);
599 end;
600 freememory(textbuf,true);
601 freememory(ctrlbuf,true);
602 destarea^.f^.closemsg(destmsg);
603 dispose(xmsgnew);
604 if p^.dostat<>nil then dodostatment(destfcarea,destarea,newnr,p^.dostat);
605 if p^.msgbase<>nil then
606 if strpas(p^.msgbase)<>'' then begin
607 destarea^.f^.closearea(area);
608 end;
609 end;
610
611 procedure actionrewrite(var fcara:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;num:word;p:paction);
612 var
613 s:string;
614 i:word;
615 ppp,pp:pchar;
616 ctrlbuf,textbuf:pchar;
617 ctrlsize,textsize:longint;
618 o,d:netaddr;
619 begin
620 logit(1,'ACTION REWRITE: Subaction '+z2s(p^.spe)+' '+p^.str);
621 if p^.str[1]='"' then delete(p^.str,1,1);
622 if p^.str[length(p^.str)]='"' then delete(p^.str,length(p^.str),1);
623 logit(1,'ACTION REWRITE: Subaction '+z2s(p^.spe)+' '+p^.str);
624 case p^.spe of
625 actionrewriteFromName:begin
626 s:=copy(p^.str,1,32); while length(s)<32 do s:=S+#0;
627 for i:=1 to 32 do xmsg^.fromname[i-1]:=s[i];
628 area^.f^.WriteMsg(msg,0,xmsg,nil,0,0,0,nil);
629 end;
630 actionrewriteToName:begin
631 s:=copy(p^.str,1,32); while length(s)<32 do s:=S+#0;
632 for i:=1 to 32 do xmsg^.toname[i-1]:=s[i];
633 area^.f^.WriteMsg(msg,0,xmsg,nil,0,0,0,nil);
634 end;
635 actionrewriteFromAddr,actionrewriteToaddr:begin
636 textsize:=area^.f^.GetTextLen(msg);
637 ctrlsize:=area^.f^.GetCtrlLen(msg);
638 textbuf:=getmemory(textsize+1);
639 ctrlbuf:=getmemory(ctrlsize+1000);
640 area^.f^.ReadMsg(msg,xmsg,0,textsize,textbuf,ctrlsize,ctrlbuf);
641 area^.f^.closemsg(msg);
642 {Current Orig, Dest}
643 o:=xmsg^.orig; d:=xmsg^.dest;
644 getfulladdr(ctrlbuf,ctrlsize,o,d);
645 {Change Orig, create new Kludges (intl, fmpt, topt}
646 if p^.spe=actionrewriteFromAddr then begin
647 o:=p^.addr;
648 xmsg^.orig:=p^.addr;
649 end;
650 if p^.spe=actionrewriteToaddr then begin
651 d:=p^.addr;
652 xmsg^.dest:=p^.addr;
653 end;
654 pp:=createkludges(o,d,false);
655 ppp:=getmemory(strlen(ctrlbuf)+strlen(pp)+1);
656 strcopy(ppp,pp);
657 strcat(ppp,ctrlbuf);
658 msg:=area^.f^.OpenMsg(area,MOPEN_CREATE,num);
659 area^.f^.WriteMsg(msg,0,xmsg,textbuf,textsize,textsize,strlen(ppp),ppp);
660 area^.f^.closemsg(msg);
661 msg:=area^.f^.OpenMsg(area,MOPEN_READ,num);
662 freememory(textbuf,true);
663 freememory(ctrlbuf,true);
664 freememory(ppp,true);
665 freememory(pp,true);
666 end;
667 actionrewriteSubj:begin
668 s:=copy(p^.str,1,72); while length(s)<72 do s:=S+#0;
669 for i:=1 to 72 do xmsg^.subj[i-1]:=s[i];
670 area^.f^.WriteMsg(msg,0,xmsg,nil,0,0,0,nil);
671 end;
672 else begin
673 logit(9,'ACTION REWRITE: Subaction '+z2s(p^.spe)+' not found');
674 halt;
675 end;
676 end;
677 end;
678
679 procedure actionwritetofile(filename,str:string);
680 var
681 f:text;
682 begin
683 assign(f,filename);
684 if not exist(filename) then begin rewrite(f); close(f); end;
685 append(f);
686 writeln(f,transstring(str));
687 close(f);
688 end;
689
690 procedure doaction(p:paction;fcarea:ps_area;var area:pharea;var msg:phmsg;var xmsg:pxmsg;var num:longint;var del:boolean);
691 begin
692 del:=false;
693 while p<>nil do begin
694 case p^.action of
695 actionCopy_: begin
696 actioncopy(fcarea,area,msg,xmsg,num,p);
697 end;
698 actionMOVE_: begin
699 actioncopy(fcarea,area,msg,xmsg,num,p);
700 del:=True;
701 end;
702 actionDEL_: begin
703 del:=true;
704 end;
705 actionREWRITE_: begin
706 actionrewrite(fcarea,area,msg,xmsg,num,p);
707 end;
708 actionechoCopy_: begin
709 actionechocopy(fcarea,area,msg,xmsg,num,p);
710 end;
711 actionechoMove_: begin
712 actionechocopy(fcarea,area,msg,xmsg,num,p);
713 del:=true;
714 end;
715 actionexportmsg_:actionexportmsg(fcarea,area,msg,xmsg,num,p^.filename);
716 actionexportheader_:actionexportheader(fcarea,area,msg,xmsg,num,p^.filename);
717 actionSEMAPHORE_:actionSEMAPHORE(p^.filename);
718 actionbounce_:actionbounce(fcarea,area,msg,xmsg,num,p);
719 actionwritetofile_:actionwritetofile(p^.filename,p^.str);
720 else begin
721 writeln('Unknown Action ',p^.action); halt;
722 end;
723 end;
724 p:=p^.next;
725 end;
726 end;
727
728
729
730
731 procedure scan(fc:ps_fidoconfig);
732 Var
733 area:pharea;
734 msg:phmsg;
735 xmsg:pxmsg;
736 l:pliste;
737 mask:pmask;
738 num:longint;
739 anz:longint;
740 del:boolean;
741 uid:longint;
742 a:ps_area;
743 begin
744 l:=liste;
745 while l<>nil do begin
746 {OPEN}
747 if strpas(l^.msgbase)='' then begin l:=l^.next; continue; end;
748 logit(4,'Open Area '+strpas(l^.msgbase));
749 a:=getareaimp(fc,l^.msgbase);
750 if a=nil then begin logit(9,'Could not open Msgbase via fidoconfig: '+strpas(l^.msgbase)); halt; end;
751 area:=MsgOpenArea(a^.filename,MSGAREA_CRIFNEC,a^.msgbtype);
752 if area=nil then begin logit(9,'Could not open Msgbase: '+strpas(l^.msgbase)); halt; end;
753 while area^.f^.lock(area)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
754 if InvalidMh(area) then begin logit(9,'Invalid handle to Msgbase'); halt; end;
755 { if area^.num_msg<>area^.high_msg then begin logit(9,'NUM_MSG<>HIGH_MSG'); halt; end;}
756 writeln('Scanning '+strpas(l^.msgbase)+' ',area^.num_msg,' Mails');
757 new(xmsg);
758 num:=1;
759 anz:=area^.high_msg;
760 {UID}
761 if getuid(strpas(l^.msgbase),uid) then begin
762 num:=area^.f^.UidToMsgn(area,uid,uid_exact);
763 if num=0 then begin
764 num:=area^.f^.UidToMsgn(area,uid,uid_next);
765 logit(2,'UID ('+z2s(uid)+') matchs next to Msg '+z2s(num));
766 if num=0 then begin
767 logit(4,'Ignoring all Message in this Area because the UID is 0. Use Scanall if necessary.');
768 num:=anz+1;
769 end;
770 end else begin
771 inc(num);
772 logit(2,'UID ('+z2s(uid)+') matchs exact to Msg '+z2s(num));
773 end;
774 end else begin
775 logit(2,'No UID for Area '+strpas(l^.msgbase)+'. Starting at Msg 1');
776 end;
777
778 {Scanning}
779 if anz<num then begin writeln('No new messages to scan'); end;
780 while num<=anz do begin
781 msg:=area^.f^.OpenMsg(area,MOPEN_READ,num);
782 if msg=nil then begin
783 { logit(1,'Message '+z2s(num)+' does not exist');}
784 inc(num);
785 continue;
786 end;
787 logit(1,'Processing Message '+z2s(num));
788 write(num,' ');
789 area^.f^.ReadMsg(msg,xmsg,0,0,nil,0,nil);
790 mask:=l^.mask;
791 del:=false;
792 while (mask<>nil) and (del=false) do begin
793 if mask^.search=nil then begin writeln('no search statment for ',mask^.maskname); halt; end;
794 if (mask^.search^.l^.ele = 'ANY') or match_(area,msg,xmsg,mask^.search) then begin
795 inc(mask^.hits);
796 logit(4,'Message '+z2s(num)+'/'+z2s(anZ)+' '+array2string(xmsg^.subj,72)+' matchs to '+mask^.maskname);
797 if not para.test then doaction(mask^.action,a,area,msg,xmsg,num,del);
798 end;
799 mask:=mask^.next;
800 end;
801 area^.f^.closemsg(msg);
802 if del then begin
803 logit(4,'Deleting Message '+z2s(num));
804 if area^.f^.KillMsg(area,num) <>0 then begin logit(9,'Could not delete Message Nr.'+z2s(num)); halt; end;
805 if (area^.type_ <> MSGTYPE_SQUISH) then inc(num);
806 end else begin
807 inc(num);
808 end;
809 end;
810 dispose(xmsg);
811 writeln; writeln;
812 if area^.num_msg>0 then begin
813 logit(4,'SCAN: MB:'+strpas(l^.msgbase)+' Anz:'+z2s(area^.num_msg)+' Anz2:'+z2s(area^.num_msg)+' UID:'+z2s(area^.f^.msgntouid(area,area^.num_msg)));
814 storeuid(uidlisteout,strpas(l^.msgbase),area^.f^.msgntouid(area,area^.num_msg))
815 end else begin
816 logit(4,'SCAN: MB:'+strpas(l^.msgbase)+'No UID');
817 removeuid(uidlisteout,strpas(l^.msgbase));
818 end;
819 while area^.f^.unlock(area)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
820 area^.f^.closearea(area);
821 l:=l^.next;
822 end;
823 end;
824
825 procedure Statistic;
826 Var
827 no:boolean;
828 l:pliste;
829 mask:pmask;
830 s:string;
831 loglevel:byte;
832 begin
833 logit(4,'Statistics:');
834 l:=liste;
835 no:=true;
836 while l<>nil do begin
837 mask:=l^.mask;
838 while (mask<>nil) do begin
839 if mask^.hits=0 then begin
840 loglevel:=2;
841 end else begin
842 loglevel:=4; no:=false;
843 end;
844 logit(loglevel,' '+mask^.maskname+' ('+l^.msgbase+') : '+z2s(mask^.hits));
845 mask:=mask^.next;
846 end;
847 l:=l^.next;
848 end;
849 if no then logit(4,' none');
850 end;
851
852 procedure help;
853 begin
854 writeln;
855 writeln('Commands:');
856 writeln('ScanAll Scan all Messages and execute actions.');
857 writeln('ScanNew Scan only new Messages and execute actions.');
858 writeln('Saveuid Save only the UID of the last Message. Nothing else.');
859 writeln('Check check the CFG-File. Nothing else.');
860 writeln;
861 writeln('Options:');
862 writeln('--notsave Do not save the UID of the last Message after scanning.');
863 writeln('--save Save the UID of the last Message after scanning. (Default)');
864 writeln;
865 writeln('--config=<file> Configfile (Default --config=/etc/fido/ffma)');
866 writeln('--uid=<file> File where ffma should save the uid''s.');
867 writeln('--help Help');
868 end;
869
870 procedure checkpara;
871 var
872 i:word;
873 s:string;
874 nrpara:word;
875 begin
876 fillchar(para,sizeof(para),0);
877 if paramcount=0 then begin
878 writeln('Nothing to do!');
879 help; halt;
880 end;
881 nrpara:=0;
882 para.save:=true;
883 for i:=1 to paramcount do begin
884 if nrpara>1 then begin
885 writeln('too much commands'); halt;
886 end;
887 s:=up(paramstr(i));
888 if (s='HELP') or (s='-HELP') or (s='--HELP') or (s='-?') or (s='/?') then begin para.help:=true; continue; end;
889 if (s='--DEBUG') then begin para.debug:=true; continue; end;
890 if (s='SAVEUID') then begin inc(nrpara); para.saveuid:=true; continue; end;
891 if (s='SCANALL') then begin inc(nrpara); para.scanall:=true; continue; end;
892 if (s='SCANNEW') then begin inc(nrpara); para.scannew:=true; continue; end;
893 if (s='TEST') then begin inc(nrpara); para.test:=True; continue; end;
894 if (s='CHECK') then begin inc(nrpara); para.test:=True; continue; end;
895
896 if (s='--NOTSAVE') then begin para.save:=false; continue; end;
897 if (s='--SAVE') then begin para.save:=true; continue; end;
898
899 if (copy(s,1,3)='-C=') or (copy(s,1,9)='--CONFIG=') then begin
900 s:=paramstr(i);
901 if copy(up(s),1,3)='-C' then delete(s,1,3) else delete(s,1,9);
902 if not exist(s) then begin writeln('File not found: `',s,'`'); halt; end;
903 configfile:=s;
904 continue;
905 end;
906 if (copy(s,1,3)='-U=') or (copy(s,1,6)='--UID=') then begin
907 s:=paramstr(i);
908 if copy(up(s),1,3)='-U' then delete(s,1,3) else delete(s,1,6);
909 ffmauid:=s;
910 continue;
911 end;
912 writeln('unrecognized option/command `'+paramstr(i)+'`'); halt;
913 end;
914 if para.test then logit(9,'TESTMODE');
915 if para.help then begin help; halt; end;
916 end;
917
918 procedure storeuid_;
919 Var
920 area:pharea;
921 l:pliste;
922 anz:longint;
923 fcarea:ps_area;
924 begin
925 l:=liste;
926 while l<>nil do begin
927 if strpas(l^.msgbase)='' then begin l:=l^.next; continue; end;
928 logit(4,'Open Area '+strpas(l^.msgbase));
929 fcarea:=getareaimp(fc,l^.msgbase);
930 if fcarea=nil then begin logit(9,'Could not open Msgbase: '+strpas(l^.msgbase)); halt; end;
931 area:=MsgOpenArea(fcarea^.filename,MSGAREA_CRIFNEC,fcarea^.msgbtype);
932 if area=nil then begin logit(9,'Could not open Msgbase: '+strpas(l^.msgbase)); halt; end;
933 while area^.f^.lock(area)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
934 if InvalidMh(area) then begin logit(9,'Invalid handle to Msgbase'); halt; end;
935 { if area^.num_msg<>area^.high_msg then begin logit(9,'NUM_MSG<>HIGH_MSG'); halt; end;}
936 anz:=area^.high_msg;
937 logit(3,strpas(l^.msgbase)+': Msg '+z2s(area^.high_msg)+' Uid:'+z2s(area^.f^.msgntouid(area,anz)));
938 if anz>0 then storeuid(uidlisteout,strpas(l^.msgbase),area^.f^.msgntouid(area,anz));
939 while area^.f^.unlock(area)<>0 do begin writeln('MsgBase locked. Waiting!'); delay(5000); end;
940 area^.f^.closearea(area);
941 l:=l^.next;
942 end;
943 end;
944
945
946 var
947 m:p_minf;
948 list:pliste;
949 mask:pmask;
950 ok:boolean;
951 i:longint;
952 begin
953 ok:=false;
954 randomize;
955 {$ifdef FPC}{$ifdef LINUX} ok:=true; compiler:='FPC/LINUX'; {$endif}{$endif}
956 {$ifdef __GPC__}
957 writeln('Warning!');
958 writeln('This version of FFMA is compiled with GPC.');
959 writeln('Maybe this version does not work correct! Be careful!');
960 writeln;
961 writeln('Press enter to continue');
962 readln;
963 compiler:='GPC';
964 ok:=true;
965 {$endif}
966
967 if not ok then begin
968 writeln('Please do not use FFMA under this OS!'); halt(255);
969 end;
970
971 fc:=readconfig(NIL);
972 openlogfile(strpas(fc^.logfiledir)+'ffma.log');
973 if getConfigFileNameForProgram('FFMA','ffma.ini')<>nil then begin
974 configfile:=getConfigFileNameForProgram('FFMA','ffma.ini');
975 end;
976
977 logit(2,'FreeFidoMessageAssistant '+version+' '+compiler);
978 logit(2,'Copyright by Sven Bursch, Germany 1998-1999');
979 logit(2,'FFMA comes with ABSOLUTELY NO WARRANTY. See COPYING');
980 logit(2,'');
981 logit(0,'Memory: '+z2s(memavail)+' Configfile: '+configfile);
982
983 checkpara;
984 readini(configfile,fc);
985 if ffmauid='' then begin
986 ffmauid:=getConfigFileName;
987 for i:=length(ffmauid) downto 1 do begin
988 if ffmauid[i] in ['\','/'] then break;
989 delete(ffmauid,i,1);
990 end;
991 ffmauid:=ffmauid+'ffma.uid';
992 end;
993
994 {Open Smapi}
995 new(m); m^.req_version:=0; m^.def_zone:=2;
996 if msgopenapi(m)<>0 then begin writeln('Could not open MsgApi'); halt; end;
997
998 {Loading UID}
999 if para.scannew then loaduid;
1000
1001 {Scaning}
1002 if para.scannew or para.scanall or para.test then begin
1003 scan(fc);
1004 statistic;
1005 end;
1006 {Storing UID}
1007 if para.saveuid then storeuid_;
1008
1009 {Close Smapi}
1010 msgcloseapi; dispose(m);
1011
1012 {Saving UID}
1013 if (para.save) and (not para.test) then writeuidtofile(uidlisteout);
1014
1015 {Cleanup}
1016 shownotfree;
1017 logit(0,z2s(memavail));
1018 logit(3,'Normal exit');
1019 end.
1020