mysticbbs/mystic/mutil_echoimport.pas

Unit MUTIL_EchoImport;

{$I M_OPS.PAS}

Interface

Procedure uEchoImport;

Implementation

Uses
  DOS,
  m_FileIO,
  m_Strings,
  BBS_Common,
  BBS_MsgBase_ABS,
  BBS_MsgBase_JAM,
  BBS_MsgBase_Squish,
  mUtil_Common,
  mUtil_Status,
  mUtil_EchoCore;

// Also create SavePKTMsgToFile and change export to use it... and for
// downlinks too

Procedure SavePKTMsgToBase (Var MB: PMsgBaseABS; Var PKT: TPKTReader; Netmail: Boolean);
Var
  Count : LongInt;
Begin
  MB^.StartNewMsg;

  If NetMail Then
    MB^.SetMailType (mmtNetMail)
  Else
    MB^.SetMailType (mmtEchoMail);

  MB^.SetLocal (False);
  MB^.SetOrig  (PKT.Orig);
  MB^.SetDest  (PKT.Dest);

  MB^.SetPriv     ((PKT.MsgHDR.Attribute AND pktPrivate <> 0) OR NetMail);
  MB^.SetCrash    (PKT.MsgHDR.Attribute AND pktCrash    <> 0);
  MB^.SetRcvd     (PKT.MsgHDR.Attribute AND pktReceived <> 0);
  //MB^.SetSent   (PKT.MsgHDR.Attribute AND pktSent     <> 0);
  MB^.SetSent     (False);  // force to send to downlinks?
  MB^.SetHold     (PKT.MsgHDR.Attribute AND pktHold     <> 0);
  MB^.SetKillSent (PKT.MsgHDR.Attribute AND pktKillSent <> 0);

  MB^.SetFrom     (PKT.MsgFrom);
  MB^.SetTo       (PKT.MsgTo);
  MB^.SetSubj     (PKT.MsgSubj);
  MB^.SetDate     (PKT.MsgDate);
  MB^.SetTime     (PKT.MsgTime);

  For Count := 1 to PKT.MsgLines Do Begin
    If {strip seenbys and } Copy(PKT.MsgText[Count]^, 1, 9) = 'SEEN-BY: ' Then
      Continue;

    MB^.DoStringLn(PKT.MsgText[Count]^);
  End;

  MB^.WriteMsg;
End;

Procedure uEchoImport;
Var
  TotalEcho  : LongInt;
  TotalNet   : LongInt;
  TotalDupes : LongInt;
  EchoNode   : RecEchoMailNode;

  Procedure ImportNetMailpacket (ArcFN: String);
  Var
    PKT     : TPKTReader;
    MBase   : RecMessageBase;
    MsgBase : PMsgBaseABS;
  Begin
    PKT := TPKTReader.Create;

    If PKT.Open (bbsConfig.InboundPath + ArcFN) Then Begin
      If GetMBaseByNetZone (PKT.PKTHeader.DestZone, MBase) Then Begin
        MessageBaseOpen(MsgBase, MBase);

        While PKT.GetMessage(True) Do Begin
          // Check for AreaFix, etc here

          SavePKTMsgToBase(MsgBase, PKT, True);

          Log (2, '+', '      Netmail ' + MBase.EchoTag + ' from ' + PKT.MsgFrom + ' to ' + PKT.MsgTo);

          Inc (TotalNet);
        End;

        MsgBase^.CloseMsgBase;

        Dispose (MsgBase, Done);
      End Else
        Log (3, '!', '   No NETMAIL base for zone ' + strI2S(PKT.PKTHeader.DestZone));
    End Else
      Log (3, '!', '   ' + ArcFN + ' is not valid PKT');

    PKT.Free;

    FileErase (bbsConfig.InBoundPath + ArcFN);
  End;

  Procedure ImportEchoMailPacket (ArcFN: String);
  Var
    DirInfo  : SearchRec;
    FoundPKT : Boolean;
    CurTag   : String;
    MsgBase  : PMsgBaseABS;
    PKT      : TPKTReader;
    MBase    : RecMessageBase;
    Part     : LongInt;
    Whole    : LongInt;
  Begin
    FoundPKT := False;
    PKT      := TPKTReader.Create;
    MsgBase  := NIL;
    Part     := 0;

    ProcessStatus (ArcFN + ' from ' + strAddr2Str(EchoNode.Address), False);

    ExecuteArchive (bbsConfig.InboundPath + ArcFN, EchoNode.ArcType, '*', 2);

    Whole := DirFiles(TempPath);

    BarOne.Reset;

    FindFirst (TempPath + '*', AnyFile, DirInfo);

    While DosError = 0 Do Begin
      If DirInfo.Attr And Directory = 0 Then Begin
        Inc (Part);

        BarOne.Update (Part, Whole);

        If strUpper(JustFileExt(DirInfo.Name)) = 'PKT' Then Begin
          FoundPKT := True;
          CurTag   := '';

          If Not PKT.Open(TempPath + DirInfo.Name) Then Begin
            Log (3, '!', '   ' + DirInfo.Name + ' is not valid PKT');

            FindNext(DirInfo);

            Continue;
          End;

          While PKT.GetMessage(False) Do Begin
            If PKT.IsDuplicate Then Begin
              Log (3, '!', '      Duplicate message found in ' + PKT.MsgArea);

              Inc (TotalDupes);
            End Else Begin
              If CurTag <> PKT.MsgArea Then Begin
                If Not GetMBaseByTag(PKT.MsgArea, MBase) Then Begin
                  Log (2, '!', '   Area ' + PKT.MsgArea + ' does not exist');

                  // create base here optionally and do not CONTINUE fall
                  // through to save message.  or optionally move to badmsg
                  // or dupemsg base
                  Continue;
                End;

                If MsgBase <> NIL Then Begin
                  MsgBase^.CloseMsgBase;

                  Dispose (MsgBase, Done);

                  MsgBase := NIL;
                End;

                MessageBaseOpen(MsgBase, MBase);

                CurTag := PKT.MsgArea;
              End;

              SavePKTMsgToBase (MsgBase, PKT, False);

              PKT.AddDuplicate;

              Inc (TotalEcho);

              Log (2, '+', '      Added Msg #' + strI2S(MsgBase^.GetHighMsgNum) + ' to ' + strStripPipe(MBase.Name));
            End;
          End;

          If MsgBase <> NIL Then Begin
            MsgBase^.CloseMsgBase;

            Dispose (MsgBase, Done);

            MsgBase := NIL;
          End;

          PKT.MsgFile.Close;
        End;

//        PKT.MsgFile.Close;

        FileErase (TempPath + DirInfo.Name);
      End;

      FindNext (DirInfo);
    End;

    FindClose (DirInfo);

    If MsgBase <> NIL Then Begin
      MsgBase^.CloseMsgBase;

      Dispose (MsgBase, Done);

      MsgBase := NIL;
    End;

    If Not FoundPKT Then
      Log (2, '!', '   Unable to find PKT in packet. Archive issue?');

    PKT.Free;

    FileErase (bbsConfig.InboundPath + ArcFN);
  End;

Var
  DirInfo     : SearchRec;
  NodeFile    : File of RecEchoMailNode;
  Count       : LongInt;
  FoundPacket : Byte;
Begin
  TotalEcho  := 0;
  TotalNet   := 0;
  TotalDupes := 0;

  ProcessName   ('Importing EchoMail', True);
  ProcessResult (rWORKING, False);

  DirClean (TempPath, '');

  If Not DirExists(bbsConfig.InboundPath) Then Begin
    ProcessStatus ('Inbound directory does not exist', True);
    ProcessResult (rFATAL, True);

    Exit;
  End;

  FindFirst (bbsConfig.InboundPath + '*', AnyFile, DirInfo);

  While DosError = 0 Do Begin
    If DirInfo.Attr And Directory = 0 Then Begin
      FoundPacket := 0;

      If strUpper(JustFileExt(DirInfo.Name)) = 'PKT' Then Begin
        FoundPacket := 2;
        // NETMAIL
      End Else Begin
        // ECHOMAIL
        Assign (NodeFile, bbsConfig.DataPath + 'echonode.dat');

        If ioReset(NodeFile, Sizeof(RecEchoMailNode), fmRWDN) Then Begin
          While Not Eof(NodeFile) Do Begin
            Read (NodeFile, EchoNode);

            For Count := 1 to 30 Do Begin
              If strUpper(JustFileName(DirInfo.Name)) = strUpper(GetFTNArchiveName(EchoNode.Address, bbsConfig.NetAddress[Count])) Then Begin
                FoundPacket := 1;

                Break;
              End;
            End;
          End;

          Close (NodeFile);
        End;
      End;

      Case FoundPacket of
        0 : Log (2, '!', '   Unknown inbound file: ' + DirInfo.Name);
        1 : ImportEchoMailPacket (DirInfo.Name);
        2 : ImportNetMailPacket  (DirInfo.Name);
      End;
    End;

    FindNext (DirInfo);
  End;

  FindClose (DirInfo);

  ProcessStatus ('Total |15' + strI2S(TotalEcho) + ' |07echo |15' + strI2S(TotalNet) + ' |07net |15' + strI2S(TotalDupes) + ' |07dupe', True);
  ProcessResult (rDONE, True);
 End;

End.