1 Unit PTOut;
2 Interface
3
4 {$Q-}
5
6 Uses
7 {$IfDef UNIX}
8 linux,
9 {$EndIf}
10 DOS,
11 Types, GeneralP,
12 Log,
13 TickCons, TickType;
14
15 Type
16 pOutbound = ^tOutbound;
17 pBTOutbound = ^tBTOutbound;
18 pFDOutbound = ^tFDOutbound;
19
20 tOutbound =
21 object
22 Constructor Init;
23 Destructor Done; Virtual;
24
25 {check/set/unset BusyFlags for an user}
IsBusynull26 Function IsBusy(User: pUser): Boolean; Virtual;
27 Procedure SetBusy(User: pUser); Virtual;
28 Procedure UnSetBusy(User: pUser); Virtual;
29
30 {send a file to a user, check if it already was sent}
31 Procedure SendFile(User: pUser; FName: String; Action: Byte); Virtual;
CheckFileSentnull32 Function CheckFileSent(User: pUser; FName: String): Boolean; Virtual;
33
34 {get a name for an archive, remove zero-length archives}
ArchiveNamenull35 Function ArchiveName(User: pUser): String; Virtual;
36 Procedure PurgeArchs; Virtual;
37 end;
38
39 tBTOutbound =
40 object(tOutbound)
41
42 Constructor Init(_Cfg: PTickCfg; _lh: Byte; _BaseDir: String;
43 _PrimAKA: tNetAddr);
44 Destructor Done; Virtual;
45
46 {check/set/unset BusyFlags for an user}
IsBusynull47 Function IsBusy(User: pUser): Boolean; Virtual;
48 Procedure SetBusy(User: pUser); Virtual;
49 Procedure UnSetBusy(User: pUser); Virtual;
50
51 {send a file to a user, check if it already was sent}
52 Procedure SendFile(User: pUser; FName: String; Action: Byte); Virtual;
CheckFileSentnull53 Function CheckFileSent(User: pUser; FName: String): Boolean; Virtual;
54
55 {get a name for an archive, remove zero-length archives}
ArchiveNamenull56 Function ArchiveName(User: pUser): String; Virtual;
57 Procedure PurgeArchs; Virtual;
58
59
60 private
61 BaseDir: String; {directory of primary zone}
62 PrimAKA: tNetAddr; {primary AKA}
63 lh: Byte;
64 Cfg: PTickCfg;
65
FloNamenull66 Function FloName(Usr: pUser): String;
67 Procedure PurgeArchsDir(Dir: String);
68 end;
69
70 tFDOutbound =
71 object (tOutbound)
72
73 Constructor Init(_STQFile: String; _LCKFile: String; _lh: Byte; _TicDir: String; _FlagDir: String);
74 Destructor Done; Virtual;
75
76 {check/set/unset BusyFlags for an user}
IsBusynull77 Function IsBusy(User: pUser): Boolean; Virtual;
78 Procedure SetBusy(User: pUser); Virtual;
79 Procedure UnSetBusy(User: pUser); Virtual;
80
81 {send a file to a user, check if it already was sent}
82 Procedure SendFile(User: pUser; FName: String; Action: Byte); Virtual;
CheckFileSentnull83 Function CheckFileSent(User: pUser; FName: String): Boolean; Virtual;
84
85 {get a name for an archive, remove zero-length archives}
ArchiveNamenull86 Function ArchiveName(User: pUser): String; Virtual;
87 Procedure PurgeArchs; Virtual;
88
89 private
90 STQFile: String;
91 LCKFile: String;
92 TicDir: String;
93 FlagDir: String;
94 STQ: file;
95 ValidQueue: Boolean;
96 Rev: Word;
97 lh: Byte;
98 {global}
99 TimeCreated, TimePacked, ReservedLong, PackRecovery: LongInt;
100 {single record}
101 EntryTime, Flags, TimeStamp: LongInt;
102 Address, FileName, TFA: String;
103
104 Procedure ReadHdr;
105 Procedure WriteHdr;
106 Procedure ReadEntry;
107 Procedure WriteEntry;
OpenSTQnull108 Function OpenSTQ: Boolean;
109 Procedure ForceRescan;
FileBusynull110 Function FileBusy(FName: String): Boolean;
111 Procedure PurgeArchsDir(Dir: String);
112 end;
113
114
115 Implementation
116
117 Const
118 {FD}
119 FQflgKFS =$00000001; {Kill file after sending, w/checking}
120 FQflgKFSNoCheck =$00000002; {Like KFS, but w/o checking}
121 FQflgTFS =$00000004; {Trunc file after sending w/checking}
122 FQflgTFSNoCheck =$00000008; {Like TFS, but w/o checking}
123 FQflgIsARCmail =$00000020; {ARCmail attach}
124 FQflgSendStart =$00000040; {FD has started to send this file}
125 FQflgSendAfter =$00020000; {Date contains entry release date}
126 FQflgKeepExpired=$00040000; {Keep expired entry}
127 FQflgSendUntil =$00080000; {Date contains entry expiration date}
128 FQflgIsHold =$00100000; {Hold}
129 FQflgIsCrash =$00200000; {Crash}
130 FQflgIsIMM =$00400000; {Immediate}
131 FQflgNoPickup =$00800000; {Must be delivered}
132 FQflgIsSpool =$01000000; {Spool mask (Permanent + KFSNoCheck)}
133 FQflgIsFREQ =$02000000; {Is file request}
134 FQflgIsFile =$04000000; {Is file attach}
135 FQflgTFA =$08000000; {TFA field contains alias filename}
136 FQflgHidden =$20000000; {Hidden entry, don't display}
137 FQflgLocked =$40000000; {Locked entry, ignore}
138 FQflgDeleted =$80000000; {Entry has been deleted}
139 FQflgPassword =$08000000; {Used for File Requests}
140 FQmacHasFilename=(FQflgIsFREQ or FQflgIsFile);
141
142
143 Procedure Abstract; Begin Halt(211); End;
144
145 Constructor tOutbound.Init;
146 Begin Fail; End;
147
148 Destructor tOutbound.Done;
149 Begin Abstract; End;
150
151
tOutbound.IsBusynull152 Function tOutbound.IsBusy(User: pUser): Boolean;
153 Begin Abstract; End;
154
155 Procedure tOutbound.SetBusy(User: pUser);
156 Begin Abstract; End;
157
158 Procedure tOutbound.UnSetBusy(User: pUser);
159 Begin Abstract; End;
160
161
162 Procedure tOutbound.SendFile(User: pUser; FName: String; Action: Byte);
163 Begin Abstract; End;
164
tOutbound.CheckFileSentnull165 Function tOutbound.CheckFileSent(User: pUser; FName: String): Boolean;
166 Begin Abstract; End;
167
tOutbound.ArchiveNamenull168 Function tOutbound.ArchiveName(User: pUser): String;
169 Begin Abstract; End;
170
171 Procedure tOutbound.PurgeArchs;
172 Begin Abstract; End;
173
174
175 Constructor tBTOutbound.Init(_Cfg: PTickCfg; _lh: Byte; _BaseDir: String;
176 _PrimAKA: tNetAddr);
177
178 Begin
179 Cfg := _Cfg;
180 lh := _lh;
181 BaseDir := _BaseDir;
182 PrimAKA := _PrimAKA;
183 LogSetCurLevel(lh, 5);
184 LogWriteLn(lh, 'BaseDir = "'+_BaseDir+'"/"'+BaseDir+'"');
185 End;
186
187 Destructor tBTOutbound.Done;
188 Begin
189
190 End;
191
192
tBTOutbound.IsBusynull193 Function tBTOutbound.IsBusy(User: pUser): Boolean;
194 Var
195 Tmp: String;
196
197 Begin
198 Tmp := FLOName(User);
199 Tmp[0] := Char(Byte(Tmp[0])-3); {remove 'flo'}
200 IsBusy := FileExist(Tmp + 'bsy');
201 End;
202
203 Procedure tBTOutbound.SetBusy(User: pUser);
204 Var
205 Tmp: String;
206 f: File;
207
208 Begin
209 Tmp := FLOName(User);
210 Tmp[0] := Char(Byte(Tmp[0])-3); {remove 'flo'}
211 Assign(f, Tmp + 'bsy');
212 {$I-} ReWrite(f); {$I+}
213 If (IOResult = 0) then Close(f)
214 Else
215 Begin
216 LogSetCurLevel(lh, 1);
217 LogWriteLn(lh, 'Could not create BusyFile "'+Tmp+'bsy"!');
218 End;
219 End;
220
221 Procedure tBTOutbound.UnSetBusy(User: pUser);
222 Var
223 Tmp: String;
224
225 Begin
226 Tmp := FLOName(User);
227 Tmp[0] := Char(Byte(Tmp[0])-3); {remove 'flo'}
228 If not DelFile(Tmp + 'bsy') then
229 Begin
230 LogSetCurLevel(lh, 1);
231 LogWriteLn(lh, 'Could not remove BusyFile "'+Tmp+'bsy"!');
232 End;
233 End;
234
235
236 Procedure tBTOutbound.SendFile(User: pUser; FName: String; Action: Byte);
237 Var
238 f: Text;
239 FlowName: String;
240 Error1, Error2: Integer;
241
242 Begin
243 FlowName := FloName(User);
244 Assign(f, FlowName);
245 {$I-} Append(f); {$I+}
246 Error1 := IOResult;
247 If (Error1 <> 0) then
248 Begin
249 Assign(f, FlowName);
250 {$I-} ReWrite(f); {$I+}
251 Error2 := IOResult;
252 If (Error2 <> 0) then
253 Begin
254 LogSetCurLevel(lh, 1);
255 LogWriteLn(lh, 'Couldn''t open "'+FlowName+'": Error '+
256 IntToStr(Error1)+', '+IntToStr(Error2)+'!');
257 Exit;
258 End;
259 End;
260 {$I-}
261 Case Action of
262 ac_Nothing : WriteLn(f, FName);
263 ac_Del : WriteLn(f, '^'+FName);
264 ac_Trunc : WriteLn(f, '#'+FName);
265 else
266 WriteLn(f, FName);
267 end;
268 If (IOResult <> 0) then
269 Begin
270 LogSetCurLevel(lh, 1);
271 LogWriteLn(lh, 'Error writing "'+FlowName+'"!');
272 End;
273 Close(f); {$I+}
274 If (IOResult <> 0) then
275 Begin
276 LogSetCurLevel(lh, 1);
277 LogWriteLn(lh, 'Couldn''t close "'+FlowName+'"!');
278 End
279 Else
280 Begin
281 {$IfDef UNIX}
282 Chmod(FlowName, FilePerm);
283 {$EndIf}
284 End;
285 End;
286
tBTOutbound.CheckFileSentnull287 Function tBTOutbound.CheckFileSent(User: pUser; FName: String): Boolean;
288 Var
289 Tmp: String;
290 f: Text;
291 Line: String;
292 Found: Boolean;
293
294 Begin
295 {$IfNDef UNIX}
296 FName := UpStr(FName);
297 {$EndIf}
298 Found := False;
299 Tmp := FLOName(User);
300 Tmp[Length(Tmp)-2] := 'f'; {flavour normal}
301 Assign(f, Tmp);
302 {$I-} ReSet(f); {$I+}
303 If (IOResult = 0) then While not (EOF(f) or Found) do
304 Begin
305 ReadLn(f, Line);
306 If (Line[1] = '~') then Continue; {skip sent files}
307 If (Line[1] in ['#', '^']) then Delete(Line, 1, 1);
308 {$IfDef UNIX}
309 Found := Found or (Line = FName);
310 {$Else}
311 Found := Found or (Upstr(Line) = FName);
312 {$EndIf}
313 End;
314
315 If not Found then
316 Begin
317 Tmp[Length(Tmp)-2] := 'c'; {flavour crash}
318 Assign(f, Tmp);
319 {$I-} ReSet(f); {$I+}
320 If (IOResult = 0) then While not (EOF(f) or Found) do
321 Begin
322 ReadLn(f, Line);
323 If (Line[1] = '~') then Continue; {skip sent files}
324 If (Line[1] in ['#', '^']) then Delete(Line, 1, 1);
325 {$IfDef UNIX}
326 Found := Found or (Line = FName);
327 {$Else}
328 Found := Found or (Upstr(Line) = FName);
329 {$EndIf}
330 End;
331 End;
332
333 If not Found then
334 Begin
335 Tmp[Length(Tmp)-2] := 'd'; {flavour direct}
336 Assign(f, Tmp);
337 {$I-} ReSet(f); {$I+}
338 If (IOResult = 0) then While not (EOF(f) or Found) do
339 Begin
340 ReadLn(f, Line);
341 If (Line[1] = '~') then Continue; {skip sent files}
342 If (Line[1] in ['#', '^']) then Delete(Line, 1, 1);
343 {$IfDef UNIX}
344 Found := Found or (Line = FName);
345 {$Else}
346 Found := Found or (Upstr(Line) = FName);
347 {$EndIf}
348 End;
349 End;
350
351 If not Found then
352 Begin
353 Tmp[Length(Tmp)-2] := 'h'; {flavour hold}
354 Assign(f, Tmp);
355 {$I-} ReSet(f); {$I+}
356 If (IOResult = 0) then While not (EOF(f) or Found) do
357 Begin
358 ReadLn(f, Line);
359 If (Line[1] = '~') then Continue; {skip sent files}
360 If (Line[1] in ['#', '^']) then Delete(Line, 1, 1);
361 {$IfDef UNIX}
362 Found := Found or (Line = FName);
363 {$Else}
364 Found := Found or (Upstr(Line) = FName);
365 {$EndIf}
366 End;
367 End;
368
369 CheckFileSent := not Found;
370 End;
371
372
tBTOutbound.ArchiveNamenull373 Function tBTOutbound.ArchiveName(User: pUser): String;
374 Var
375 CurName: String;
376
377 Begin
378 CurName := FLOName(User);
379 CurName[0] := Char(Byte(CurName[0])-3); {remove 'flo'}
380 CurName := CurName + 'c00';
381 While (FileExist(CurName) and (GetFSize(CurName) = 0)) do
382 Begin
383 If (CurName[Length(CurName)] = '9') then
384 Begin
385 If (CurName[Length(CurName)-1] = '9') then
386 Begin
387 LogSetCurLevel(lh, 1);
388 LogWriteLn(lh, 'no free archive name for "'+User^.Name+'" ('+
389 Addr2Str(User^.Addr)+')!');
390 ArchiveName := '';
391 Exit;
392 End
393 Else Inc(CurName[Length(CurName)-1]);
394 End
395 Else Inc(CurName[Length(CurName)]);
396 End;
397 ArchiveName := CurName;
398 End;
399
400 Procedure tBTOutbound.PurgeArchs;
401 Begin
402 { LogSetCurLevel(lh, 5);
403 LogWriteLn(lh, 'BaseDir = "'+BaseDir+'"');
404 LogWriteLn(lh, 'Calling PurchArchsDir("'+ Copy(BaseDir, 1, LastPos(DirSep, BaseDir)-1)+ '")');}
405 PurgeArchsDir(Copy(BaseDir, 1, LastPos(DirSep, BaseDir)-1));
406 End;
407
408 Procedure tBTOutbound.PurgeArchsDir(Dir: String);
409 Var
410 {$IfDef SPEED}
411 SRec: TSearchRec;
412 {$Else}
413 SRec: SearchRec;
414 {$EndIf}
415 l: Byte;
416
417 Begin
418 { LogSetCurLevel(lh, 5);
419 LogWriteLn(lh, 'tBTOutbound.PurgeArchsDir("'+Dir+'") called');}
420 SRec.Name := Dir + DirSep+ '*.*';
421 { LogWriteLn(lh, 'Calling FindFirst("'+ SRec.Name+ ', AnyFile, SRec)');}
422 FindFirst(SRec.Name, AnyFile, SRec);
423 While (DosError = 0) do
424 Begin
425 LogSetCurLevel(lh, 5);
426 { LogWriteLn(lh, 'DosError = 0');}
427 l := Length(SRec.Name);
428 { LogWriteLn(lh, 'Length(SRec.Name) = '+ IntToStr(l));}
429 If (SRec.Attr and Directory) = 0 then
430 Begin
431 LogSetCurLevel(lh, 5);
432 { LogWriteLn(lh, 'not Directory');}
433 If (SRec.Name[l-3] = '.') and (UpCase(SRec.Name[l-2]) = 'C') then
434 Begin
435 { LogWriteLn(lh, '*.[Cc]?? found');}
436 If not ((SRec.Name[l-1] < '0') or (SRec.Name[l-1] > '9')
437 or (SRec.Name[l] < '0') or (SRec.Name[l] > '9')) then
438 Begin
439 { LogWriteLn(lh, '*.[Cc][0-9][0-9] found');}
440 If (GetFSize(Dir + DirSep + SRec.Name) = 0) then
441 Begin
442 Write('Deleting '+Dir + DirSep + SRec.Name+'...');
443 If Not DelFile(Dir + DirSep + SRec.Name) then
444 Begin
445 WriteLn;
446 LogSetCurLevel(lh, 1);
447 LogWriteLn(lh, 'Couldn''t delete '+Dir+DirSep+SRec.Name+'!');
448 End
449 Else WriteLn(' Done');
450 End;
451 End;
452 End;
453 End
454 Else
455 Begin
456 { LogSetCurLevel(lh, 5);
457 LogWriteLn(lh, 'Directory');}
458 If (SRec.Name[1] <> '.') then PurgeArchsDir(Dir + DirSep + SRec.Name);
459 End;
460 LogSetCurLevel(lh, 5);
461 { LogWriteLn(lh, 'Calling FindNext');}
462 FindNext(SRec);
463 End;
464 End;
465
466
tBTOutbound.FloNamenull467 Function tBTOutbound.FloName(Usr: pUser): String;
468 Var
469 s, s1: String;
470 FlowName: String;
471 Dir: String;
472 Addr: TNetAddr;
473 i: Byte;
474
475 Begin
476 If CompAddr(Usr^.ArcAddr, EmptyAddr) then Addr := Usr^.Addr Else Addr := Usr^.ArcAddr;
477 If ((Addr.Domain = PrimAKA.Domain) or (Addr.Domain = '') or (PrimAKA.Domain = '')) then
478 Begin
479 If (Addr.Zone <> PrimAKA.Zone) then
480 Begin
481 If (Addr.Zone < 4096) then FlowName := Cfg^.OutBound+'.'+Copy(WordToHex(word(Addr.Zone)), 2, 3)+DirSep
482 Else FlowName := Cfg^.OutBound+'.'+WordToHex(Word(Addr.Zone))+DirSep;
483 End
484 Else FlowName := Cfg^.OutBound + DirSep;
485 End
486 Else
487 Begin
488 s := BaseDir;
489 While (s[Length(s)] <> DirSep) do Delete(s, Length(s), 1);
490 s1 := Addr.Domain;
491 If (Cfg^.NumDomains > 0) then
492 Begin
493 For i := 1 to Cfg^.NumDomains do
494 If (UpStr(Addr.Domain) = UpStr(Cfg^.Domains[i].Domain)) then
495 s1 := Cfg^.Domains[i].Abbrev;
496 End;
497 FlowName := s + s1 + '.'+Copy(WordToHex(word(Addr.Zone)), 2, 3)+DirSep;
498 End;
499 Dir := Copy(FlowName, 1, Length(FlowName) - 1);
500 FlowName := FlowName + WordToHex(word(Addr.Net)) + WordToHex(word(Addr.Node));
501 If (Addr.Point <> 0) then
502 Begin
503 Dir := FlowName + '.pnt';
504 FlowName := FlowName + '.pnt'+DirSep+'0000' + WordToHex(word(Addr.Point));
505 End;
506 Case Usr^.MailFlags of
507 ml_Normal : FlowName := FlowName + '.flo';
508 ml_Direct : FlowName := FlowName + '.dlo';
509 ml_Hold : FlowName := FlowName + '.hlo';
510 ml_Crash : FlowName := FlowName + '.clo';
511 end;
512 If not DirExist(Dir) then If not MakeDir(Dir) then
513 Begin
514 LogSetCurLevel(lh, 1);
515 LogWriteLn(lh, 'Couldn''t create directory "'+Dir+'"!');
516 End
517 Else
518 Begin
519 LogSetCurLevel(lh, 2);
520 LogWriteLn(lh, 'Created directory "'+Dir+'"');
521 End;
522 FloName := FlowName;
523 End;
524
525
526 Constructor tFDOutbound.Init(_STQFile: String; _LCKFile: String; _lh: Byte; _TicDir: String; _FlagDir: String);
527 Begin
528 STQFile := _STQFile;
529 LCKFile := _LCKFile;
530 lh := _lh;
531 TicDir := _TicDir;
532 FlagDir := _FlagDir;
533 End;
534
535 Destructor tFDOutbound.Done;
536 Begin
537
538 End;
539
540
tFDOutbound.IsBusynull541 Function tFDOutbound.IsBusy(User: pUser): Boolean;
542 Begin
543 {does nothing}
544 IsBusy := False;
545 End;
546
547 Procedure tFDOutbound.SetBusy(User: pUser);
548 Begin
549 {does nothing}
550 End;
551
552 Procedure tFDOutbound.UnSetBusy(User: pUser);
553 Begin
554 {does nothing}
555 End;
556
557
558 Procedure tFDOutbound.SendFile(User: pUser; FName: String; Action: Byte);
559 Var
560 i: Byte;
561 DT: TimeTyp;
562
563 Begin
564 If not OpenSTQ then Exit;
565 ReadHdr;
566
567 {set entry values}
568 Today(DT); Now(DT); EntryTime := DTToUnixDate(DT);
569 TimeStamp := EntryTime;
570 Address := Addr2StrND(User^.ArcAddr);
571 FileName := FName;
572 TFA := '';
573 Flags := FQflgIsFile;
574 If (Action = ac_Del) then Flags := Flags or FQflgKFSNoCheck
575 Else if (Action = ac_Trunc) then Flags := Flags or FQflgTFSNoCheck;
576 Case User^.MailFlags of
577 ml_Crash: Flags := Flags or FQflgIsCrash;
578 ml_Direct: Flags := Flags or FQflgIsIMM;
579 ml_Hold: Flags := Flags or FQflgIsHold;
580 { ml_Normal: do nothing}
581 End;
582
583 {check lock}
584 i := 1;
585 While (FileExist(LCKFile) and (i < 12)) do
586 Begin
587 Inc(i);
588 Delay(1000);
589 End;
590 If FileExist(LCKFile) then
591 Begin
592 LogSetCurLevel(lh, 1);
593 LogWriteLn(lh, 'tFDOutbound: Could not send file "'+FName+'" to User "'+
594 User^.Name+'" ('+Addr2Str(User^.Addr)+'): STQ locked for more than 10 seconds!');
595
596 Close(STQ);
597 End
598 Else
599 Begin
600 {set lock}
601 CreateSem(LCKFile);
602
603 {append entry}
604 Seek(STQ, filesize(STQ));
605 WriteEntry;
606
607 {reset lock}
608 DelFile(LCKFile);
609
610 Close(STQ);
611
612 {force rescan?}
613 If (User^.MailFlags <> ml_Hold) then ForceReScan;
614 End;
615 End;
616
tFDOutbound.CheckFileSentnull617 Function tFDOutbound.CheckFileSent(User: pUser; FName: String): Boolean;
618 Var
619 Error: Integer;
620 DT: TimeTyp;
621 Addr: TNetAddr;
622
623 Begin
624 If not OpenSTQ then Exit;
625 ReadHdr;
626
627 If (not EOF(STQ)) then
628 Begin
629 Repeat
630 ReadEntry;
631 Str2Addr(Address, Addr);
632
633 Until (EOF(STQ) or (CompAddr(Addr, User^.ArcAddr) and (FName = FileName)));
634 CheckFileSent := not CompAddr(Addr, User^.ArcAddr) or (FName <> FileName)
635 or ((Flags and FQflgDeleted) > 0); {no entry or deleted entry => file already sent}
636 End
637 Else CheckFileSent := True; {no entry in STQ => file already sent}
638 Close(STQ);
639 End;
640
tFDOutbound.ArchiveNamenull641 Function tFDOutbound.ArchiveName(User: pUser): String;
642 Var
643 CurName: String;
644
645 Begin
646 {directory structure:
647 Cfg^.TicDir
648 |
649 +-zone.001 Dir
650 |
651 +-zone.002 Dir
652 | |
653 | +-098301a8.pnt Dir
654 | | |
655 | | +-00000001.c00 File
656 | |
657 | +-09830000.c00 File
658 |
659 +-zone.02c Dir
660
661 }
662
663 {calculate first name, create necessary dirs}
664 CurName := TicDir+DirSep+'zone.';
665 If (User^.ArcAddr.Zone < 4096) then CurName := CurName+Copy(WordToHex(Word(User^.ArcAddr.Zone)), 2, 3)
666 Else CurName := CurName+WordToHex(Word(User^.ArcAddr.Zone));
667 MakeDir(CurName);
668 CurName := CurName+DirSep + WordToHex(word(User^.ArcAddr.Net)) +
669 WordToHex(word(User^.ArcAddr.Node));
670 If (User^.ArcAddr.Point <> 0) then
671 Begin
672 CurName := CurName + '.pnt' + DirSep + '0000' + WordToHex(word(User^.ArcAddr.Point));
673 MakeDir(CurName+'.pnt');
674 End;
675 CurName := CurName + '.c00';
676
677 {Find unused name}
678 While (FileExist(CurName) and ((GetFSize(CurName) = 0) or FileBusy(CurName))) do
679 Begin
680 If (CurName[Length(CurName)] = '9') then
681 Begin
682 If (CurName[Length(CurName)-1] = '9') then
683 Begin
684 LogSetCurLevel(lh, 1);
685 LogWriteLn(lh, 'no free archive name for "'+User^.Name+'" ('+
686 Addr2Str(User^.Addr)+')!');
687 ArchiveName := '';
688 Exit;
689 End
690 Else Inc(CurName[Length(CurName)-1]);
691 End
692 Else Inc(CurName[Length(CurName)]);
693 End;
694 ArchiveName := CurName;
695 End;
696
697 Procedure tFDOutbound.PurgeArchs;
698 Begin
699 PurgeArchsDir(TicDir);
700 End;
701
702
703 Procedure tFDOutbound.ReadHdr;
704 Var
705 Sig: String[22];
706 Maj, Min: Byte;
707 Long1, Long2, Long3, Long4: Byte;
708 DT: TimeTyp;
709
710 Begin
711 Sig[0] := Char(22);
712 BlockRead(STQ, Sig[1], 22);
713 If (Sig = 'FrontDoor File Queue'#26#0) then
714 Begin
715 BlockRead(STQ, Min, 1);
716 BlockRead(STQ, Maj, 1);
717 Rev := Min + (Maj * 256);
718 If (Rev = $0100) then
719 Begin
720 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
721 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
722 TimeCreated := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
723 UnixToDT(TimeCreated, DT);
724
725 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
726 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
727 TimePacked := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
728 UnixToDT(TimePacked, DT);
729
730 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
731 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
732 ReservedLong := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
733
734 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
735 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
736 PackRecovery := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
737
738 Seek(STQ, 1024); {0-based => pos = 1025}
739 ValidQueue := True;
740 End
741 Else
742 Begin
743 LogSetCurLevel(lh, 1);
744 LogWriteLn(lh, 'tFDOutbound: Invalid Queue revision!');
745 ValidQueue := False;
746 End;
747 End
748 Else
749 Begin
750 LogSetCurLevel(lh, 1);
751 LogWriteLn(lh, 'tFDOutbound: Invalid Queue signature!');
752 ValidQueue := False;
753 End;
754 End;
755
756 Procedure tFDOutbound.WriteHdr;
757 Const Sig: String[22] = 'FrontDoor File Queue'#26#00;
758 Var
759 Maj, Min: Byte;
760 Long1, Long2, Long3, Long4: Byte;
761 i: Word;
762 HdrBuf: Array[0..1023] of Byte;
763
764 Begin
765 {Signature}
766 for i := 1 to 22 do HdrBuf[i - 1] := Byte(Sig[i]);
767
768 {rev $0100}
769 HdrBuf[22] := $00;
770 HdrBuf[23] := $01;
771
772 {TimeCreated}
773 Long1 := TimeCreated mod 256; Long2 := (TimeCreated div 256) mod 256;
774 Long3 := (TimeCreated div 65536) mod 256; Long4 := (TimeCreated div 16777216);
775 HdrBuf[24] := Long1; HdrBuf[25] := Long2;
776 HdrBuf[26] := Long3; HdrBuf[27] := Long4;
777
778 {TimePacked}
779 Long1 := TimePacked mod 256; Long2 := (TimePacked div 256) mod 256;
780 Long3 := (TimePacked div 65536) mod 256; Long4 := (TimePacked div 16777216);
781 HdrBuf[28] := Long1; HdrBuf[29] := Long2;
782 HdrBuf[30] := Long3; HdrBuf[31] := Long4;
783
784 {ReservedLong}
785 Long1 := 0; Long2 := 0; Long3 := 0; Long4 := 0;
786 HdrBuf[32] := Long1; HdrBuf[33] := Long2;
787 HdrBuf[34] := Long3; HdrBuf[35] := Long4;
788
789 {PackRecovery}
790 Long1 := 0; Long2 := 0; Long3 := 0; Long4 := 0;
791 HdrBuf[36] := Long1; HdrBuf[37] := Long2;
792 HdrBuf[38] := Long3; HdrBuf[39] := Long4;
793
794 {fill up to 1024 Bytes}
795 For i := 40 to 1023 do HdrBuf[i] := 0;
796
797 BlockWrite(STQ, HdrBuf, 1024);
798
799 ValidQueue := True;
800 End;
801
802 Procedure tFDOutbound.ReadEntry;
803 Var
804 EntryLen: Word;
805 Min, Maj: Byte;
806 Long1, Long2, Long3, Long4: Byte;
807 DT: TimeTyp;
808
809 Begin
810 BlockRead(STQ, Min, 1);
811 BlockRead(STQ, Maj, 1);
812 EntryLen := Word(Min) + (Word(Maj) * 256);
813
814 If (EntryLen >= 15) then
815 Begin
816 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
817 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
818 EntryTime := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
819 UnixToDT(EntryTime, DT);
820
821 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
822 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
823 Flags := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
824
825 BlockRead(STQ, Long1, 1); BlockRead(STQ, Long2, 1);
826 BlockRead(STQ, Long3, 1); BlockRead(STQ, Long4, 1);
827 TimeStamp := (LongInt(Long1) + (LongInt(Long2) * 256)) + ((LongInt(Long3) + (LongInt(Long4) * 256)) * 65536);
828 UnixToDT(TimeStamp, DT);
829
830 BlockRead(STQ, Address[0], 1);
831 If (Byte(Address[0]) > 0) then BlockRead(STQ, Address[1], Byte(Address[0]));
832
833 If (EntryLen > (Byte(Address[0])+14)) then
834 Begin
835 BlockRead(STQ, Filename[0], 1);
836 If (Byte(Filename[0]) > 0) then BlockRead(STQ, Filename[1], Byte(Filename[0]));
837
838 If (EntryLen >= (Byte(Address[0])+Byte(Filename[0])+15)) then
839 Begin
840 BlockRead(STQ, TFA[0], 1);
841 If (EntryLen = (Byte(Address[0])+Byte(Filename[0])+15)) then TFA[0] := Char(0);
842 If (Byte(TFA[0]) > 0) then BlockRead(STQ, TFA[1], Byte(TFA[0]));
843
844 {skip last bytes if entry is too long}
845 If (EntryLen > (Byte(Address[0])+Byte(Filename[0])+Byte(TFA[0])+15)) then
846 Begin
847 Seek(STQ, FilePos(STQ)+EntryLen-(Byte(Address[0])+Byte(Filename[0])+Byte(TFA[0])+15));
848 LogSetCurLevel(lh, 2);
849 LogWriteLn(lh, 'tFDOutbound: skipped '+IntToStr(EntryLen-(Byte(Address[0])+
850 Byte(Filename[0])+Byte(TFA[0])+15))+' Bytes of garbage.');
851 End;
852 End
853 Else TFA[0] := Char(0);
854 End;
855 End
856 Else
857 Begin
858 LogSetCurLevel(lh, 2);
859 LogWriteLn(lh, 'tFDOutbound: Entry too small => skipping '+IntToStr(EntryLen)+
860 ' Bytes.');
861 Seek(STQ, FilePos(STQ)+EntryLen);
862 End;
863 End;
864
865 Procedure tFDOutbound.WriteEntry;
866 Var
867 EntryLen: Word;
868 Min, Maj: Byte;
869 Long1, Long2, Long3, Long4: Byte;
870 EntryBuf: PChar2;
871 EntryPos: Word;
872 i: Word;
873
874 Begin
875 {EntryLen}
876 EntryLen := (Byte(Address[0])+Byte(Filename[0])+Byte(TFA[0])+15);
877 GetMem(EntryBuf, EntryLen+2);
878 Min := EntryLen mod 256; Maj := (EntryLen div 256);
879 EntryBuf^[0] := Char(Min); EntryBuf^[1] := Char(Maj);
880
881 Long1 := EntryTime mod 256; Long2 := (EntryTime div 256) mod 256;
882 Long3 := (EntryTime div 65536) mod 256; Long4 := (EntryTime div 16777216);
883 EntryBuf^[2] := Char(Long1); EntryBuf^[3] := Char(Long2);
884 EntryBuf^[4] := Char(Long3); EntryBuf^[5] := Char(Long4);
885
886 Long1 := Flags mod 256; Long2 := (Flags div 256) mod 256;
887 Long3 := (Flags div 65536) mod 256; Long4 := (Flags div 16777216);
888 EntryBuf^[6] := Char(Long1); EntryBuf^[7] := Char(Long2);
889 EntryBuf^[8] := Char(Long3); EntryBuf^[9] := Char(Long4);
890
891 Long1 := TimeStamp mod 256; Long2 := (TimeStamp div 256) mod 256;
892 Long3 := (TimeStamp div 65536) mod 256; Long4 := (TimeStamp div 16777216);
893 EntryBuf^[10] := Char(Long1); EntryBuf^[11] := Char(Long2);
894 EntryBuf^[12] := Char(Long3); EntryBuf^[13] := Char(Long4);
895
896 For i := 0 to Byte(Address[0]) do EntryBuf^[14+i] := Address[i];
897 EntryPos := 15+Byte(Address[0]);
898
899 For i := 0 to Byte(Filename[0]) do EntryBuf^[EntryPos+i] := Filename[i];
900 EntryPos := EntryPos + Byte(Filename[0])+1;
901
902 For i := 0 to Byte(TFA[0]) do EntryBuf^[EntryPos+i] := TFA[i];
903
904 BlockWrite(STQ, EntryBuf^, EntryLen+2);
905 FreeMem(EntryBuf, EntryLen+2);
906 End;
907
tFDOutbound.OpenSTQnull908 Function tFDOutbound.OpenSTQ: Boolean;
909 Var
910 Error: Integer;
911 DT: TimeTyp;
912
913 Begin
914 OpenSTQ := False;
915 Assign(STQ, STQFile);
916 {$I-} ReSet(STQ, 1); {$I+}
917 Error := IOResult;
918 If (Error <> 0) then
919 Begin
920 If (Error = 5) then {file locked}
921 Begin
922 Delay(5);
923 Assign(STQ, STQFile);
924 {$I-} ReSet(STQ, 1); {$I+}
925 Error := IOResult;
926 If (Error <> 0) then
927 Begin
928 LogSetCurLevel(lh, 1);
929 LogWriteLn(lh, 'tFDOutbound: Could not open "'+STQFile+'": Error #'+
930 IntToStr(Error)+'!');
931 Exit;
932 End;
933 End
934 Else If (Error = 2) then {file not found}
935 Begin
936 If FileExist(LCKFile) then
937 Begin
938 Delay(10);
939 Assign(STQ, STQFile);
940 {$I-} ReSet(STQ, 1); {$I+}
941 Error := IOResult;
942 If (Error <> 0) then
943 Begin
944 LogSetCurLevel(lh, 1);
945 LogWriteLn(lh, 'tFDOutbound: Could not open "'+STQFile+'": Error #'+
946 IntToStr(Error)+'!');
947 Exit;
948 End;
949 End
950 Else
951 Begin
952 {$I-} ReWrite(STQ, 1); {$I+}
953 Error := IOResult;
954 If (Error <> 0) then
955 Begin
956 LogSetCurLevel(lh, 1);
957 LogWriteLn(lh, 'tFDOutbound: Could not create "'+STQFile+'": Error #'+
958 IntToStr(Error)+'!');
959 Exit;
960 End;
961 Now(DT); TimeCreated := DTToUnixDate(DT); TimePacked := TimeCreated;
962 LogSetCurLevel(lh, 3);
963 LogWriteLn(lh, 'Creating new STQ');
964 WriteHdr;
965 Close(STQ);
966 {$IfDef UNIX}
967 ChMod(STQFile, FilePerm);
968 {$EndIf}
969 ReSet(STQ, 1);
970 End;
971 End
972 Else
973 Begin
974 LogSetCurLevel(lh, 1);
975 LogWriteLn(lh, 'tFDOutbound: Could not open "'+STQFile+'": Error #'+
976 IntToStr(Error)+'!');
977 Exit;
978 End;
979 End;
980 OpenSTQ := True;
981 End;
982
983 Procedure tFDOutbound.ForceRescan;
984 Begin
985 CreateSem(FlagDir + 'FDRESCAN.NOW');
986 End;
987
tFDOutbound.FileBusynull988 Function tFDOutbound.FileBusy(FName: String): Boolean;
989 Var
990 Addr: TNetAddr;
991
992 Begin
993 If not OpenSTQ then Exit;
994 ReadHdr;
995
996 If (not EOF(STQ)) then
997 Begin
998 Repeat
999 ReadEntry;
1000 Str2Addr(Address, Addr);
1001
1002 Until (EOF(STQ) or (FName = FileName));
1003 FileBusy := (FName <> FileName)
1004 or ((Flags and $80000000) > 0); {no entry or deleted entry => file already sent}
1005 If (FName <> FileName) then FileBusy := False {not in STQ => not busy}
1006 Else
1007 Begin
1008 If (Flags and FQflgDeleted) > 0 then FileBusy := False
1009 Else If (Flags and FQflgLocked) > 0 then FileBusy := False {ignore entry}
1010 Else If (Flags and FQflgSendStart) > 0 then FileBusy := True
1011 Else FileBusy := False;
1012 End;
1013 End
1014 Else FileBusy := False; {no entry in STQ => file cannot be busy}
1015 Close(STQ);
1016 End;
1017
1018 Procedure tFDOutbound.PurgeArchsDir(Dir: String);
1019 Var
1020 {$IfDef SPEED}
1021 SRec: TSearchRec;
1022 {$Else}
1023 SRec: SearchRec;
1024 {$EndIf}
1025 l: Byte;
1026
1027 Begin
1028 SRec.Name := Dir + DirSep+ '*.*';
1029 FindFirst(SRec.Name, AnyFile, SRec);
1030 While (DosError = 0) do
1031 Begin
1032 l := Length(SRec.Name);
1033 If (SRec.Attr and Directory) = 0 then
1034 Begin
1035 If (SRec.Name[l-3] = '.') and (UpCase(SRec.Name[l-2]) = 'C') then
1036 Begin
1037 If not ((SRec.Name[l-1] < '0') or (SRec.Name[l-1] > '9')
1038 or (SRec.Name[l] < '0') or (SRec.Name[l] > '9')) then
1039 Begin
1040 If (GetFSize(Dir + DirSep + SRec.Name) = 0) then
1041 Begin
1042 Write('Deleting '+Dir + DirSep + SRec.Name+'...');
1043 If Not DelFile(Dir + DirSep + SRec.Name) then
1044 Begin
1045 WriteLn;
1046 LogSetCurLevel(lh, 1);
1047 LogWriteLn(lh, 'tFDOutbound: Couldn''t delete '+Dir+DirSep+SRec.Name+'!');
1048 End
1049 Else WriteLn(' Done');
1050 End;
1051 End;
1052 End;
1053 End
1054 Else If (SRec.Name[1] <> '.') then PurgeArchsDir(Dir + DirSep + SRec.Name);
1055 FindNext(SRec);
1056 End;
1057 End;
1058
1059
1060 Begin
1061 End.
1062
1063