Program FidoPoll;

// ====================================================================
// Mystic BBS Software               Copyright 1997-2013 By James Coyle
// ====================================================================
//
// This file is part of Mystic BBS.
//
// Mystic BBS is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// Mystic BBS is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Mystic BBS.  If not, see <http://www.gnu.org/licenses/>.
//
// ====================================================================

{$I M_OPS.PAS}

Uses
  DOS,
  m_Crypt,
  m_DateTime,
  m_FileIO,
  m_Strings,
  m_IO_Sockets,
  m_Protocol_Queue,
  m_tcp_Client_FTP,
  BBS_Records,
  BBS_DataBase,
  MIS_Client_BINKP;

Var
  TempPath : String;

Procedure PrintStatus (Owner: Pointer; Level: Byte; Str: String);
Var
  TF : Text;
Begin
  If Level = 1 Then
    WriteLn (Str)
  Else
    Str := '   ' + Str;

  Str      := FormatDate(CurDateDT, 'NNN DD HH:II') + ' ' + Str;
  FileMode := 66;

  Assign (TF, bbsCfg.LogsPath + 'fidopoll.log');

  {$I-} Append (TF); {$I+}

  If (IoResult <> 0) and (IoResult <> 5) Then
    {$I-} ReWrite(TF); {$I+}

  If IoResult = 0 Then Begin
    WriteLn (TF, Str);
    Close   (TF);
  End;
End;

Function FindBundleName (Str: String) : String;
Var
  FN   : String;
  Ext  : String;
  Last : Byte;
Begin
  FN  := JustFileName(Str);
  Ext := strLower(JustFileExt(Str));

  Last := Byte(Ext[Length(Ext)]);

  If Not (Last in [48..57, 97..122]) Then Last := 48;

  Repeat
    Result := FN + '.' + Ext;
    Result[Length(Result)] := Char(Last);

    If Not FileExist(Result) Then Break;

    Inc (Last);

    If Last = 58  Then Last := 97;
    If Last = 123 Then Exit; // no 0-9,a-z could be generated
  Until False;
End;

Function PollNodeFTP (OnlyNew: Boolean; Var Queue: TProtocolQueue; Var EchoNode: RecEchoMailNode) : Boolean;
Var
  FTP   : TFTPClient;
  Count : LongInt;
Begin
  Result := False;

  Queue.Clear;

  PrintStatus (NIL, 1, 'Scanning ' + Addr2Str(EchoNode.Address));

  QueueByNode (Queue, True, EchoNode);

  PrintStatus (NIL, 1, 'Queued ' + strI2S(Queue.QSize) + ' files (' + strI2S(Queue.QFSize) + ' bytes) to ' + Addr2Str(EchoNode.Address));

  If OnlyNew and (Queue.QSize = 0) Then Exit;

  PrintStatus (NIL, 1, 'Polling FTP node ' + Addr2Str(EchoNode.Address));

  FTP := TFTPClient.Create(bbsCfg.iNetInterface);

  If FTP.OpenConnection(EchoNode.ftpOutHost) Then Begin
    PrintStatus (NIL, 1, 'Connected');

    If FTP.Authenticate(EchoNode.ftpOutLogin, EchoNode.ftpOutPass) Then Begin
      If FTP.GetDirectoryList(EchoNode.ftpPassive, True, EchoNode.ftpInDir) Then Begin
        For Count := 1 to FTP.ResponseData.Count Do Begin
          PrintStatus (NIL, 1, 'Receiving ' + FTP.ResponseData.Strings[Count - 1]);

          If FTP.GetFile (EchoNode.ftpPassive, bbsCfg.InboundPath + FTP.ResponseData.Strings[Count - 1]) = ftpResOK Then Begin
            If FTP.SendCommand('DELE ' + FTP.ResponseData.Strings[Count - 1]) <> 250 Then
              FileErase(bbsCfg.InboundPath + FTP.ResponseData.Strings[Count - 1])
            Else
              PrintStatus (NIL, 1, 'Unable to delete from server ' + FTP.ResponseData.Strings[Count - 1]);
          End Else
            PrintStatus (NIL, 1, 'Failed');
        End;
      End Else
        PrintStatus (NIL, 1, 'Unable to list ' + EchoNode.ftpInDir);

      If Queue.QSize > 0 Then Begin
        If FTP.ChangeDirectory(EchoNode.ftpOutDir) Then Begin
          For Count := 1 to Queue.QSize Do Begin
            PrintStatus (NIL, 1, 'Sending ' + Queue.QData[Count]^.FileNew);

            If FTP.SendFile(EchoNode.ftpPassive, Queue.QData[Count]^.FilePath + Queue.QData[Count]^.FileName, Queue.QData[Count]^.FileNew) = ftpResOK Then Begin
              FileErase          (Queue.QData[Count]^.FilePath + Queue.QData[Count]^.FileName);
              RemoveFilesFromFLO (GetFTNOutPath(EchoNode), TempPath, Queue.QData[Count]^.FilePath + Queue.QData[Count]^.FileName);
            End Else
              PrintStatus (NIL, 1, 'Failed');
          End;
        End Else
          PrintStatus (NIL, 1, 'Unable to change to ' + echoNode.ftpOutDir);
      End;
    End Else
      PrintStatus (NIL, 1, 'Unable to authenticate');
  End Else
    PrintStatus (NIL, 1, 'Unable to connect');

  PrintStatus (NIL, 1, 'Session complete');

  FTP.Free;
End;

Function PollNodeDirectory (OnlyNew: Boolean; Var Queue: TProtocolQueue; Var EchoNode: RecEchoMailNode) : Boolean;
Var
  Count   : LongInt;
  DirInfo : SearchRec;
  PKTName : String;
  NewName : String;
  OutPath : String;
Begin
  Result := False;

  Queue.Clear;

  PrintStatus (NIL, 1, 'Scanning ' + Addr2Str(EchoNode.Address));

  QueueByNode (Queue, False, EchoNode);

  PrintStatus(NIL, 1, 'Queued ' + strI2S(Queue.QSize) + ' files (' + strI2S(Queue.QFSize) + ' bytes) to ' + Addr2Str(EchoNode.Address));

  If OnlyNew and (Queue.QSize = 0) Then Exit;

  PrintStatus(NIL, 1, 'Polling DIRECTORY node ' + Addr2Str(EchoNode.Address));

  OutPath := GetFTNOutPath(EchoNode);

  For Count := 1 to Queue.QSize Do Begin
    PKTName := Queue.QData[Count]^.FilePath + Queue.QData[Count]^.FileName;
    NewName := FindBundleName(EchoNode.DirInDir + Queue.QData[Count]^.FileNew);

    PrintStatus (NIL, 1, 'Move ' + PKTName + ' to ' + NewName);

    If (Not FileExist(NewName)) And FileReName(PKTName, NewName) Then
      RemoveFilesFromFLO (OutPath, TempPath, PKTName)
    Else
      PrintStatus (NIL, 1, 'Failed to move to ' + NewName);
  End;

  FindFirst (EchoNode.DirOutDir + '*', AnyFile, DirInfo);

  While DosError = 0 Do Begin
    If DirInfo.Attr And Directory = 0 Then Begin
      PrintStatus (NIL, 1, 'Move ' + EchoNode.DirOutDir + DirInfo.Name + ' to ' + bbsCfg.InboundPath);

      If (Not FileExist(bbsCfg.InboundPath + DirInfo.Name)) and (Not FileReName(EchoNode.DirOutDir + DirInfo.Name, bbsCfg.InboundPath + DirInfo.Name)) Then
        PrintStatus (NIL, 1, 'Failed to move to ' + EchoNode.DirOutDir + DirInfo.Name);
    End;

    FindNext (DirInfo);
  End;

  FindClose (DirInfo);
End;

Function PollNodeBINKP (OnlyNew: Boolean; Var Queue: TProtocolQueue; Var EchoNode: RecEchoMailNode) : Boolean;
Var
  BinkP  : TBinkP;
  Client : TIOSocket;
  Port   : Word;
Begin
  Result := False;

  Queue.Clear;

  PrintStatus(NIL, 1, 'Scanning ' + Addr2Str(EchoNode.Address));

  QueueByNode (Queue, True, EchoNode);

  PrintStatus(NIL, 1, 'Queued ' + strI2S(Queue.QSize) + ' files (' + strI2S(Queue.QFSize) + ' bytes) to ' + Addr2Str(EchoNode.Address));

  If OnlyNew and (Queue.QSize = 0) Then Exit;

  PrintStatus(NIL, 1, 'Polling BINKP node ' + Addr2Str(EchoNode.Address));

  Client := TIOSocket.Create;

  Client.FTelnetClient := False;
  Client.FTelnetServer := False;

  PrintStatus (NIL, 1, 'Connecting to ' + EchoNode.binkHost);

  Port := strS2I(strWordGet(2, EchoNode.binkHost, ':'));

  If Port = 0 Then Port := 24554;

  If Not Client.Connect (strWordGet(1, EchoNode.binkHost, ':'), Port) Then Begin
    PrintStatus (NIL, 1, 'UNABLE TO CONNECT');

    Client.Free;

    Exit;
  End;

  PrintStatus(NIL, 1, 'Connected');

  BinkP := TBinkP.Create(Client, Client, Queue, True, EchoNode.binkTimeOut * 100);

  BinkP.StatusUpdate := @PrintStatus;
  BinkP.SetOutPath   := GetFTNOutPath(EchoNode);
  BinkP.SetPassword  := EchoNode.binkPass;
  BinkP.SetBlockSize := EchoNode.binkBlock;
  BinkP.UseMD5       := EchoNode.binkMD5 > 0;
  BinkP.ForceMD5     := EchoNode.binkMD5 = 2;

  If BinkP.DoAuthentication Then Begin
    Result := True;

    BinkP.DoTransfers;
  End;

  BinkP.Free;
  Client.Free;
End;

Function PollByAddress (Addr: String) : Boolean;
Var
  Queue    : TProtocolQueue;
  PollTime : LongInt;
  EchoNode : RecEchoMailNode;
Begin
  PollTime := CurDateDos;
  Queue    := TProtocolQueue.Create;

  Result := GetNodeByAddress(Addr, EchoNode);

  If Result And EchoNode.Active Then Begin
    Case EchoNode.ProtType of
      0 : If PollNodeBINKP(False, Queue, EchoNode) Then
            EchoNode.LastSent := PollTime;
      1 : If PollNodeFTP(False, Queue, EchoNode) Then
            EchoNode.LastSent := PollTime;
      2 : If PollNodeDirectory(False, Queue, EchoNode) Then
            EchoNode.LastSent := PollTime;
    End;

    // needs to save updated polltime
  End Else
    Result := False;

  Queue.Free;
End;

Procedure PollAll (OnlyNew: Boolean);
Var
  Queue    : TProtocolQueue;
  EchoFile : File of RecEchoMailNode;
  EchoNode : RecEchoMailNode;
  Total    : LongInt;
  PollTime : LongInt;
Begin
  PollTime := CurDateDos;

  WriteLn ('Polling nodes...');
  WriteLn;

  Total := 0;
  Queue := TProtocolQueue.Create;

  Assign (EchoFile, bbsCfg.DataPath + 'echonode.dat');
  {$I-} Reset (EchoFile); {$I+}

  If IoResult <> 0 Then Exit;

  While Not Eof(EchoFile) Do Begin
    Read (EchoFile, EchoNode);

    If EchoNode.Active Then Begin
      Case EchoNode.ProtType of
        0 : If PollNodeBINKP(OnlyNew, Queue, EchoNode) Then
              EchoNode.LastSent := PollTime;
        1 : If PollNodeFTP(OnlyNew, Queue, EchoNode) Then
              EchoNode.LastSent := PollTime;
        2 : If PollNodeDirectory(False, Queue, EchoNode) Then
              EchoNode.LastSent := PollTime;
      End;

      Seek  (EchoFile, FilePos(EchoFile) - 1);
      Write (EchoFile, EchoNode);
    End;
  End;

  Close (EchoFile);

  Queue.Free;

  WriteLn;
  PrintStatus (NIL, 1, 'Polled ' + strI2S(Total) + ' nodes');
End;

Var
  Str : String;
Begin
  FileMode := 66;

  WriteLn;
  WriteLn ('FIDOPOLL Version ' + mysVersion);
  WriteLn;

  Case bbsCfgStatus of
    CfgNotFound : Begin
                    WriteLn ('Unable to read MYSTIC.DAT');
                    Halt(1);
                  End;
    CfgMisMatch : Begin
                    WriteLn ('Mystic VERSION mismatch');
                    Halt(1);
                  End;
  End;

  If ParamCount = 0 Then Begin
    WriteLn ('This program will send and retreive echomail packets for configured');
    WriteLn ('echomail nodes using any of BINKP, FTP, or Directory-based transmission');
    WriteLn;
    WriteLn ('FIDOPOLL SEND      - Only send/poll if node has new outbound messages');
    WriteLn ('FIDOPOLL FORCED    - Poll/send to all configured/activenodes');
    WriteLn ('FIDOPOLL [Address] - Poll/send echomail node [Address] (ex: 46:1/100)');

    Halt(1);
  End;

  TempPath := bbsCfg.SystemPath + 'tempftn' + PathChar;

  DirCreate(TempPath);

  Str := strUpper(strStripB(ParamStr(1), ' '));

  If (Str = 'SEND') or (Str = 'FORCED') Then
    PollAll (Str = 'SEND')
  Else
  If Not PollByAddress(Str) Then
    PrintStatus (NIL, 1, 'Invalid command line or address');
End.