mysticbbs/mystic/mis_client_nntp.pas

Unit MIS_Client_NNTP;

{$I M_OPS.PAS}

// RFC 977

Interface

Uses
  SysUtils,
  m_Strings,
  m_FileIO,
  m_Socket_Class,
  m_DateTime,
  MIS_Server,
  MIS_NodeData,
  MIS_Common;

Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;

Type
  TNNTPServer = Class(TServerClient)
    Server   : TServerManager;
    UserName : String[30];
    LoggedIn : Boolean;
    Cmd      : String;
    Data     : String;
    User     : RecUser;
    UserPos  : LongInt;
    MBase    : RecMessageBase;
    MBasePos : LongInt;

    Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
    Procedure   Execute; Override;
    Destructor  Destroy; Override;

    Procedure   ClientWriteLine (Str: String);
    Procedure   ResetSession;

    Procedure   cmd_AUTHINFO;
    Procedure   cmd_GROUP;
    Procedure   cmd_LIST;
    Procedure   cmd_XOVER;
  End;

Implementation

Uses
  bbs_MsgBase_ABS,
  bbs_MsgBase_JAM,
  bbs_MsgBase_Squish;

Const
  FileReadBuffer   = 2048;

  re_Greeting      = '200 Mystic BBS NNTP server ready';
  re_Goodbye       = '205 Goodbye';
  re_ListFollows   = '215 List follows';
  re_AuthOK        = '281 Authentication accepted';
  re_AuthBad       = '381 Authentication rejected';
  re_AuthPass      = '381 Password required';
  re_AuthReq       = '450 Auth required';
  re_AuthSync      = '482 Bad Authentication sequence';
  re_Unknown       = '500 Unknown command';
  re_UnknownOption = '501 Unknown option';

Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
  Result := TNNTPServer.Create(Owner, CliSock);
End;

Constructor TNNTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Begin
  Inherited Create(Owner, CliSock);

  Server := Owner;
End;

Procedure TNNTPServer.ClientWriteLine (Str: String);
Begin
  Server.Server.Status('S:' + Str);
  Client.WriteLine(Str);
End;

Procedure TNNTPServer.ResetSession;
Begin
  LoggedIn := False;
  UserName := '';
  UserPos  := -1;
  MBasePos := -1;
End;

Procedure TNNTPServer.cmd_AUTHINFO;
Var
  NewCmd  : String;
  NewData : String;
Begin
  NewCmd  := strWordGet(1, Data, ' ');
  NewData := Copy(Data, Pos(' ', Data) + 1, 255);

  If NewCmd = 'USER' Then Begin
    If SearchForUser(NewData, User, UserPos) Then Begin
      ClientWriteLine(re_AuthPass);

      UserName := NewData;
    End Else
      ClientWriteLine(re_AuthBad);
  End Else
  If NewCmd = 'PASS' Then Begin
    If UserPos = -1 Then
      ClientWriteLine(re_AuthSync)
    Else
    If strUpper(NewData) = User.Password Then Begin
      ClientWriteLine(re_AuthOK);
      LoggedIn := True;
    End Else
      ClientWriteLine(re_AuthBad);
  End Else
    ClientWriteLine(re_UnknownOption);

  If LoggedIn Then
    Server.Server.Status('Logged in as ' + UserName);
End;

Procedure TNNTPServer.cmd_GROUP;
Var
  MBaseFile : TBufFile;
  TempBase  : RecMessageBase;
  MsgBase   : PMsgBaseABS;
  Active    : LongInt = 0;
  Low       : LongInt = 0;
  High      : LongInt = 0;
  Found     : Boolean = False;
Begin
  If Not LoggedIn Then Begin
    ClientWriteLine(re_AuthReq);
    Exit;
  End;

  MBaseFile := TBufFile.Create(FileReadBuffer);

  If MBaseFile.Open(bbsConfig.DataPath + 'mbases.dat', fmOpen, fmRWDN, SizeOf(RecMessageBase)) Then Begin
    MBaseFile.Read(TempBase);

    While Not MBaseFile.EOF Do Begin
      MBaseFile.Read(TempBase);

      If (TempBase.NewsName = Data) and CheckAccess(User, True, TempBase.ReadACS) Then Begin
        Found := True;

        Case TempBase.BaseType of
          0 : MsgBase := New(PMsgBaseJAM, Init);
          1 : MsgBase := New(PMsgBaseSquish, Init);
        End;

        MsgBase^.SetMsgPath (TempBase.Path + TempBase.FileName);

        If MsgBase^.OpenMsgBase Then Begin
          Low    := 1;
          High   := MsgBase^.GetHighMsgNum;
          Active := MsgBase^.NumberOfMsgs;
        End;

        Dispose (MsgBase, Done);

        MBase    := TempBase;
        MBasePos := MBaseFile.FilePos;

        ClientWriteLine('211 ' + strI2S(Active) + ' ' + strI2S(Low) + ' ' + strI2S(High) + ' ' + TempBase.NewsName);

        Break;
      End;
    End;
  End;

  MBaseFile.Free;

  If Not Found Then
    ClientWriteLine('411 No such newsgroup');
End;

Procedure TNNTPServer.cmd_LIST;
Var
  MBaseFile   : TBufFile;
  TempBase    : RecMessageBase;
  MsgBase     : PMsgBaseABS;
  LowMessage  : LongInt;
  HighMessage : LongInt;
  PostAbility : Char;
Begin
  If Not LoggedIn Then Begin
    ClientWriteLine(re_AuthReq);
    Exit;
  End;

  ClientWriteLine(re_ListFollows);

  If Data = 'OVERVIEW.FMT' Then Begin
    ClientWriteLine ('Subject:');
    ClientWriteLine ('From:');
    ClientWriteLine ('Date:');
    ClientWriteLine ('Message-ID:');
    ClientWriteLine ('References:');
    ClientWriteLine ('Bytes:');
    ClientWriteLine ('Lines:');
    ClientWriteLine ('.');
    // find this in RFC to make sure this website isnt wrong
    Exit;
  End;

  MBaseFile := TBufFile.Create(FileReadBuffer);

  If MBaseFile.Open(bbsConfig.DataPath + 'mbases.dat', fmOpen, fmRWDN, SizeOf(RecMessageBase)) Then Begin
    MBaseFile.Read(TempBase);

    While Not MBaseFile.EOF Do Begin
      MBaseFile.Read(TempBase);

      If TempBase.NewsName = '' Then Continue;

      If CheckAccess(User, True, TempBase.ListACS) Then Begin
        LowMessage  := 0;
        HighMessage := 0;

        Case CheckAccess(User, True, TempBase.PostACS) of
          False : PostAbility := 'n';
          True  : PostAbility := 'y';
        End;

        Case TempBase.BaseType of
          0 : MsgBase := New(PMsgBaseJAM, Init);
          1 : MsgBase := New(PMsgBaseSquish, Init);
        End;

        MsgBase^.SetMsgPath (TempBase.Path + TempBase.FileName);

        If MsgBase^.OpenMsgBase Then Begin
          LowMessage  := 1;
          HighMessage := MsgBase^.GetHighActiveMsgNum;
        End;

        Dispose (MsgBase, Done);

        ClientWriteLine (TempBase.NewsName + ' ' + strI2S(LowMessage) + ' ' + strI2S(HighMessage) + ' ' + PostAbility);
      End;
    End;
  End;

  MBaseFile.Free;

  ClientWriteLine('.');
End;

Procedure TNNTPServer.cmd_XOVER;
Var
  First : LongInt = 0;
  Last  : LongInt = 0;
  Found : Boolean = False;
Begin
  If Not LoggedIn Then Begin
    ClientWriteLine(re_AuthReq);
    Exit;
  End;

  If MBasePos = -1 Then Begin
    ClientWriteLine('412 No newsgroup selected');
    Exit;
  End;

  If Pos('-', Data) > 0 Then Begin
    First := strS2I(strWordGet(1, Data, '-'));
    Last  := strS2I(strWordGet(2, Data, '-'));
  End Else Begin
    First := strS2I(Data);
    Last  := First;
  End;

  // if last = 0 and first <> 0 then
  //   last = all messages
  // else
  //   first = current article (what sets this value)
  //   last  = current article (what sets this value)

  // 224 Overview information
  // send messages here
  // set found if a message was found.  format per line then a term line is:
  // msgnum + tab + subj + tab + from + tab + datetime + tab + #0 + tab + msgbytes + tab + msglines + tab + #0
  // .

  // confusion: if no article send error below or tab tab? ive read both.

  If Not Found Then
    ClientWriteLine('420 No article(s) selected');
End;

Procedure TNNTPServer.Execute;
Var
  Str : String;
Begin
  ResetSession;

  ClientWriteLine(re_Greeting);

  Repeat
    If Client.WaitForData(bbsConfig.inetNNTPTimeout * 1000) = 0 Then Break;

    If Terminated Then Exit;

    If Client.ReadLine(Str) = -1 Then Exit;

    Server.Server.Status('C:' + Str);

    Cmd := strUpper(strWordGet(1, Str, ' '));

    If Pos(' ', Str) > 0 Then
      Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
    Else
      Data := '';

    If Cmd = 'AUTHINFO' Then cmd_AUTHINFO Else
    If Cmd = 'GROUP'    Then cmd_GROUP Else
    If Cmd = 'LIST'     Then cmd_LIST Else
    If Cmd = 'QUIT'     Then Break Else
    If Cmd = 'XOVER'    Then cmd_XOVER Else
      ClientWriteLine(re_Unknown);
  Until Terminated;

  If Not Terminated Then ClientWriteLine(re_Goodbye);
End;

Destructor TNNTPServer.Destroy;
Begin
  Inherited Destroy;
End;

End.