FTP QWK download

mystic/bbs_database.pas

@@ -24,6 +24,7 @@ Const
 
 Function  GetBaseConfiguration  (UseEnv: Boolean; Var TempCfg: RecConfig) : Byte;
 Function  PutBaseConfiguration  (Var TempCfg: RecConfig) : Boolean;
+Function  ShellDOS              (ExecPath: String; Command: String) : LongInt;
 
 // MESSAGE BASE
 
@@ -34,6 +35,7 @@ Procedure PutMessageScan        (UN: Cardinal; TempBase: RecMessageBase; TempSca
 
 // FILE BASE
 
+Procedure ExecuteArchive        (TempP: String; FName: String; Temp: String; Mask: String; Mode: Byte);
 Function  GetTotalFiles         (Var TempBase: RecFileBase) : LongInt;
 
 // USER
@@ -90,6 +92,29 @@ Begin
   End;
 End;
 
+Function ShellDOS (ExecPath: String; Command: String) : LongInt;
+Var
+  CurDIR : String;
+Begin
+  GetDIR (0, CurDIR);
+
+  If ExecPath <> '' Then DirChange(ExecPath);
+
+  {$IFDEF UNIX}
+    Result := Shell(Command);
+  {$ENDIF}
+
+  {$IFDEF WINDOWS}
+    If Command <> '' Then Command := '/C' + Command;
+
+    Exec (GetEnv('COMSPEC'), Command);
+
+    Result := DosExitCode;
+  {$ENDIF}
+
+  DirChange(CurDIR);
+End;
+
 Function GetMBaseByIndex (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
 Var
   F : File;
@@ -213,6 +238,64 @@ Begin
   Result := (strUpper(U.RealName) = Str) or (strUpper(U.Handle) = Str);
 End;
 
+Procedure ExecuteArchive (TempP: String; FName: String; Temp: String; Mask: String; Mode: Byte);
+Var
+  ArcFile : File;
+  Arc     : RecArchive;
+  Count   : LongInt;
+  Str     : String;
+Begin
+  If Temp <> '' Then
+    Temp := strUpper(Temp)
+  Else
+    Temp := strUpper(JustFileExt(FName));
+
+  Assign (ArcFile, bbsCfg.DataPath + 'archive.dat');
+
+  If Not ioReset (ArcFile, SizeOf(RecArchive), fmRWDN) Then Exit;
+
+  Repeat
+    If Eof(ArcFile) Then Begin
+      Close (ArcFile);
+
+      Exit;
+    End;
+
+    ioRead (ArcFile, Arc);
+
+    If (Not Arc.Active) or ((Arc.OSType <> OSType) and (Arc.OSType <> 3)) Then Continue;
+
+    If strUpper(Arc.Ext) = Temp Then Break;
+  Until False;
+
+  Close (ArcFile);
+
+  Case Mode of
+    1 : Str := Arc.Pack;
+    2 : Str := Arc.Unpack;
+  End;
+
+  If Str = '' Then Exit;
+
+  Temp  := '';
+  Count := 1;
+
+  While Count <= Length(Str) Do Begin
+    If Str[Count] = '%' Then Begin
+      Inc (Count);
+
+      If Str[Count] = '1' Then Temp := Temp + FName Else
+      If Str[Count] = '2' Then Temp := Temp + Mask Else
+      If Str[Count] = '3' Then Temp := Temp + TempP;
+    End Else
+      Temp := Temp + Str[Count];
+
+    Inc (Count);
+  End;
+
+  ShellDOS ('', Temp);
+End;
+
 Initialization
 
   bbsCfgStatus := GetBaseConfiguration(True, bbsCfg);

mystic/bbs_msgbase_qwk.pas

@@ -7,7 +7,10 @@ Interface
 Uses
   m_FileIO,
   BBS_Records,
-  BBS_DataBase;
+  BBS_DataBase,
+  BBS_MsgBase_ABS,
+  BBS_MsgBase_JAM,
+  BBS_MsgBase_Squish;
 
 Const
   QWK_EOL = #13#10;
@@ -42,7 +45,7 @@ Type
     Pos  : LongInt;
   End;
 
-  TQWKEngine_HasAccess = Function  (AcsStr: String) : Boolean;
+  TQWKEngine_HasAccess = Function  (Sender: Pointer; AcsStr: String) : Boolean;
   TQWKEngine_Status    = Procedure (Sender: Pointer; State: Byte);
 
   TQWKEngine = Class
@@ -61,7 +64,11 @@ Type
     RepBaseAdd    : LongInt;
     RepBaseDel    : LongInt;
     DataFile      : TFileBuffer;
+    MBaseFile     : File;
     MBase         : RecMessageBase;
+    QwkLR         : QwkLRRec;
+    QwkLRFile     : File of QwkLRRec;
+    MsgBase       : PMsgBaseABS;
 
     Constructor Create            (QwkPath, QwkID: String; UN: Cardinal; UR: RecUser);
     Procedure   LONG2MSB          (Index: LongInt; Var MS: BSingle);
@@ -69,6 +76,7 @@ Type
     Procedure   WriteTOREADEREXT;
     Procedure   WriteCONTROLDAT;
     Function    WriteMSGDAT : LongInt;
+    Procedure   UpdateLastReadPointers;
     Procedure   CreatePacket;
     Function    ProcessReply : Boolean;
   End;
@@ -77,10 +85,7 @@ Implementation
 
 Uses
   m_Strings,
-  m_DateTime,
+  m_DateTime;
-  BBS_MsgBase_ABS,
-  BBS_MsgBase_JAM,
-  BBS_MsgBase_Squish;
 
 Constructor TQWKEngine.Create (QwkPath, QwkID: String; UN: Cardinal; UR: RecUser);
 Begin
@@ -98,6 +103,8 @@ Begin
   RepFailed     := 0;
   RepBaseAdd    := 0;
   RepBaseDel    := 0;
+
+  Assign (MBaseFile, bbsCfg.DataPath + 'mbases.dat');
 End;
 
 Procedure TQWKEngine.LONG2MSB (Index : LongInt; Var MS : BSingle);
@@ -142,7 +149,6 @@ End;
 Procedure TQWKEngine.WriteTOREADEREXT;
 Var
   TempFile : Text;
-  BaseFile : File;
   Flags    : String;
   Base     : RecMessageBase;
 Begin
@@ -152,14 +158,12 @@ Begin
   ReWrite (TempFile);
   Write   (TempFile, 'ALIAS ' + UserRecord.Handle + QWK_EOL);
 
-  Assign (BaseFile, bbsCfg.DataPath + 'mbases.dat');
+  If ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin
 
-  If ioReset (BaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin
+    While Not Eof(MBaseFile) Do Begin
+      ioRead (MBaseFile, Base);
 
-    While Not Eof(BaseFile) Do Begin
+      If HasAccess(Self, Base.ReadACS) Then Begin
-      ioRead (BaseFile, Base);
-
-      If HasAccess(Base.ReadACS) Then Begin
         Flags := ' ';
 
         If Base.Flags AND MBPrivate = 0 Then
@@ -170,7 +174,7 @@ Begin
         If Base.Flags AND MBRealNames = 0 Then
           Flags := Flags + 'H';
 
-        If Not HasAccess(Base.PostACS) Then
+        If Not HasAccess(Self, Base.PostACS) Then
           Flags := Flags + 'BRZ';
 
         Case Base.NetType of
@@ -187,7 +191,7 @@ Begin
       End;
     End;
 
-    Close (BaseFile);
+    Close (MBaseFile);
   End;
 
   Close (TempFile);
@@ -216,14 +220,12 @@ Begin
   Write (TempFile, TotalMessages, QWK_EOL);
   Write (TempFile, TotalBases - 1, QWK_EOL);
 
-  Assign (BaseFile, bbsCfg.DataPath + 'mbases.dat');
-
   If ioReset (BaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin
 
     While Not Eof(BaseFile) Do Begin
       ioRead (BaseFile, Base);
 
-      If HasAccess(Base.ReadACS) Then Begin
+      If HasAccess(Self, Base.ReadACS) Then Begin
         Write (TempFile, Base.Index, QWK_EOL);
 
         If IsExtended Then
@@ -254,7 +256,6 @@ Var
   LastRead : LongInt;
   QwkIndex : LongInt;
   TooBig   : Boolean;
-  MsgBase  : PMsgBaseABS;
 
   Procedure DoString (Str: String);
   Var
@@ -399,12 +400,33 @@ Begin
   Result := LastRead;
 End;
 
+Procedure TQWKEngine.UpdateLastReadPointers;
+Begin
+  Reset   (QwkLRFile);
+  ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN);
+
+  While Not Eof(QwkLRFile) Do Begin
+    Read (QwkLRFile, QwkLR);
+
+    If ioSeek (MBaseFile, QwkLR.Base - 1) Then Begin
+      ioRead (MBaseFile, MBase);
+
+      If MBaseOpenCreate (MsgBase, MBase, WorkPath) Then Begin
+        MsgBase^.SetLastRead (UserNumber, QwkLR.Pos);
+        MsgBase^.CloseMsgBase;
+      End;
+
+      Dispose(MsgBase, Done);
+    End;
+  End;
+
+  Close (QwkLRFile);
+  Close (MBaseFile);
+End;
+
 Procedure TQWKEngine.CreatePacket;
 Var
   Temp  : String;
-  QwkLR     : QwkLRRec;
-  QwkLRFile : File of QwkLRRec;
-  MBaseFile : File;
   MScan : MScanRec;
 Begin
   DataFile := TFileBuffer.Create(4 * 1024);
@@ -418,8 +440,6 @@ Begin
   Assign  (QwkLRFile, WorkPath + 'qlr.dat');
   ReWrite (QwkLRFile);
 
-  Assign (MBaseFile, bbsCfg.DataPath + 'mbases.dat');
-
   If ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin
 
     If IsNetworked Then
@@ -431,7 +451,7 @@ Begin
       If IsNetworked And (MBase.Flags AND MBAllowQWKNet = 0) Then
         Continue;
 
-      If HasAccess(MBase.ReadACS) Then Begin
+      If HasAccess(Self, MBase.ReadACS) Then Begin
 
          GetMessageScan (UserNumber, MBase, MScan);
 

mystic/mis.pas

@@ -49,7 +49,8 @@ Uses
   MIS_Client_POP3,
   MIS_Client_FTP,
   MIS_Client_NNTP,
-  MIS_Client_BINKP;
+  MIS_Client_BINKP,
+  BBS_Records;
 
 Const
   FocusTelnet = 0;

mystic/mis_client_binkp.pas

@@ -14,7 +14,8 @@ Uses
   m_Protocol_Queue,
   MIS_Server,
   MIS_NodeData,
-  MIS_Common;
+  MIS_Common,
+  BBS_Records;
 
 Const
   M_NUL  = 0;

mystic/mis_client_ftp.pas

@@ -2,7 +2,7 @@ Unit MIS_Client_FTP;
 
 {$I M_OPS.PAS}
 
-{$DEFINE FTPDEBUG}
+{.$DEFINE FTPDEBUG}
 
 // does not send file/directory datestamps
 // does not support uploading (need to make bbs functions generic for this
@@ -20,7 +20,9 @@ Uses
   m_DateTime,
   MIS_Server,
   MIS_NodeData,
-  MIS_Common;
+  MIS_Common,
+  BBS_Records,
+  BBS_DataBase;
 
 Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
 
@@ -60,6 +62,8 @@ Type
     Function    GetFTPDate      (DD: LongInt) : String;
     Procedure   SendFile        (Str: String);
 
+    Function    QWKCreatePacket : Boolean;
+
     Procedure   cmdUSER;
     Procedure   cmdPASS;
     Procedure   cmdREIN;
@@ -83,6 +87,9 @@ Type
 
 Implementation
 
+Uses
+  BBS_MsgBase_QWK;
+
 Const
   FileBufSize    =  4 * 1024;
   FileXferSize   = 32 * 1024;
@@ -407,9 +414,9 @@ Begin
 
   If LoggedIn Then Begin  // and allow qwk via ftp
     If (User.Flags AND UserQwkNetwork <> 0) Then
-      Result := strLower(User.Handle) + '.qwk'
+      Result := strLower(User.Handle)
     Else
-      Result := strLower(BbsConfig.QwkBBSID) + '.qwk';
+      Result := strLower(BbsConfig.QwkBBSID);
   End;
 End;
 
@@ -445,6 +452,35 @@ Begin
   InTransfer := False;
 End;
 
+Function QWKHasAccess (Owner: Pointer; ACS: String) : Boolean;
+Begin
+  Result := CheckAccess(TQWKEngine(Owner).UserRecord, True, ACS);
+End;
+
+Function TFTPServer.QWKCreatePacket : Boolean;
+Var
+  QWK : TQwkEngine;
+Begin
+  // need to change temppath to a unique directory created for this
+  // ftp instance.  before that we need to push a unique ID to this
+  // session.
+
+  QWK := TQwkEngine.Create(TempPath, GetQWKName, UserPos, User);
+
+  QWK.HasAccess   := @QWKHasAccess;
+  QWK.IsNetworked := User.Flags AND UserQWKNetwork <> 0;
+  QWK.IsExtended  := User.QwkExtended;
+
+  QWK.CreatePacket;
+  QWK.UpdateLastReadPointers;
+  QWK.Free;
+
+  Server.Status ('Created packet in ' + TempPath);
+
+  ExecuteArchive (TempPath, TempPath + GetQWKName + '.qwk', User.Archive, TempPath + '*', 1);
+  SendFile       (TempPath + GetQWKName + '.qwk');
+End;
+
 Procedure TFTPServer.cmdUSER;
 Begin
   ResetSession;
@@ -664,7 +700,7 @@ Begin
       {$IFDEF FTPDEBUG} LOG('Back from data session'); {$ENDIF}
 
       // if qwlbyFTP.acs then
-      DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName);
+      DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk');
 
       FBaseFile := TFileBuffer.Create(FileBufSize);
 
@@ -710,7 +746,7 @@ Begin
 
     DirFile.Free;
 
-    DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName);
+    DataSocket.WriteLine('-rw-r--r--   1 ftp      ftp ' + strPadL('0', 13, ' ') + ' ' + GetFTPDate(CurDateDos) + ' ' + GetQWKName + '.qwk');
 
     CloseDataSession;
   End Else
@@ -758,13 +794,18 @@ Var
   Found    : LongInt;
 Begin
   If LoggedIn Then Begin
-    // if name = bbsid.qwk or if user is network and name is userid.qwk then
+
-    // send file here
+    If strUpper(Data) = strUpper(GetQWKName + '.qwk') Then Begin
-    // else do the normal stuff
+      QWKCreatePacket;
+
+      Exit;
+    End;
+
     TempPos := FindDirectory(TempBase);
 
     If TempPos = -1 Then Begin
       Client.WriteLine(re_BadFile);
+
       Exit;
     End;
 
@@ -785,6 +826,7 @@ Begin
 
       If Found = -1 Then Begin
         Client.WriteLine(re_BadFile);
+
         Exit;
       End;
 
@@ -940,6 +982,7 @@ Begin
     If Cmd = 'XPWD' Then cmdPWD  Else
     If Cmd = 'QUIT' Then Begin
       GotQuit := True;
+
       Break;
     End Else
       Client.WriteLine(re_NoCommand);

mystic/mis_client_nntp.pas

@@ -15,7 +15,8 @@ Uses
   m_DateTime,
   MIS_Server,
   MIS_NodeData,
-  MIS_Common;
+  MIS_Common,
+  BBS_Records;
 
 Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
 

mystic/mis_client_pop3.pas

@@ -22,7 +22,8 @@ Uses
   MIS_Common,
   BBS_MsgBase_ABS,
   BBS_MsgBase_JAM,
-  BBS_MsgBase_Squish;
+  BBS_MsgBase_Squish,
+  BBS_Records;
 
 Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
 

mystic/mis_client_smtp.pas

@@ -20,7 +20,8 @@ Uses
   bbs_MsgBase_Squish,
   MIS_Server,
   MIS_NodeData,
-  MIS_Common;
+  MIS_Common,
+  BBS_Records;
 
 Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
 

mystic/mis_client_telnet.pas

@@ -39,7 +39,8 @@ Uses
   m_Strings,
   MIS_Common,
   MIS_NodeData,
-  MIS_Server;
+  MIS_Server,
+  BBS_Records;
 
 {$IFDEF USEFORK}
   function forkpty(__amaster:Plongint; __name:Pchar; __termp:Pointer; __winp:Pointer):longint;cdecl;external 'c' name 'forkpty';

mystic/mis_common.pas

@@ -6,15 +6,14 @@ Interface
 
 Uses
   m_Output,
-  m_Term_Ansi;
+  m_Term_Ansi,
-
+  BBS_Records;
-{$I RECORDS.PAS}
 
 Var
-  bbsConfig : RecConfig;
   TempPath  : String;
   Console   : TOutput;
   Term      : TTermAnsi;
+  bbsConfig : RecConfig;
 
 Function SearchForUser    (UN: String; Var Rec: RecUser; Var RecPos: LongInt) : Boolean;
 Function CheckAccess      (User: RecUser; IgnoreGroup: Boolean; Str: String) : Boolean;

mystic/mis_nodedata.pas

@@ -37,7 +37,8 @@ Implementation
 
 Uses
   m_FileIO,
-  m_Strings;
+  m_Strings,
+  BBS_Records;
 
 Procedure TNodeData.SynchronizeNodeData;
 Var

mystic/mis_server.pas

@@ -9,7 +9,8 @@ Uses
   m_io_Base,
   m_io_Sockets,
   MIS_Common,
-  MIS_NodeData;
+  MIS_NodeData,
+  BBS_Records;
 
 Const
   MaxStatusText = 20;

mystic/whatsnew.txt

@@ -3604,4 +3604,7 @@
    you have existing FTP names set for your file bases, you must open them in
    the file base editor for their names to be automatically changed.
 
+ + Users can now download QWK packets using the FTP server.  A QWK packet
+   filename will be shown in all FTP listings.
+
    <ALPHA 37 RELEASED>