eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Initial import

This commit is contained in:
mysticbbs 2012-02-13 19:53:02 -05:00
parent fbb909c155
commit 4ab68fe2a8
18 changed files with 7371 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
mystic/mis_ansiwfc.pas Normal file
View File

@ -0,0 +1,42 @@
Procedure DrawStatusScreen;
Const
IMAGEDATA_WIDTH=80;
IMAGEDATA_DEPTH=25;
IMAGEDATA_LENGTH=518;
IMAGEDATA : array [1..518] of Char = (
#1,#23,' ','M','y','s','t','i','c',' ','I','n','t','e','r','n','e',
't',' ','S','e','r','v','e','r',#25,#30, #0,'t','e','l','n','e','t',
'/','s','m','t','p','/','p','o','p','3','/','f','t','p','/','n','n',
't','p',' ',#24, #8,#16,#26,'O','°',#24,'°', #1,'Ú',' ', #7,'C','o',
'n','n','e','c','t','i','o','n','s',' ', #1,#26,'%','Ä','¿', #8,'°',
#1,'Ú',' ', #7,'S','t','a','t','i','s','t','i','c','s',' ', #1,#26,
#9,'Ä','¿', #8,'°',#24,'°', #1,'³',#25,'2','³', #8,'°', #1,'³',#25,
#21,'³', #8,'°',#24,'°', #1,'³',#25,'2','³', #8,'°', #1,'³',#25, #5,
#7,'P','o','r','t', #8,':',#25,#10, #1,'³', #8,'°',#24,'°', #1,'³',
#25,'2','³', #8,'°', #1,'³',#25, #6, #7,'M','a','x', #8,':',#25,#10,
#1,'³', #8,'°',#24,'°', #1,'³',#25,'2','³', #8,'°', #1,'³',#25, #3,
#7,'A','c','t','i','v','e', #8,':',#25,#10, #1,'³', #8,'°',#24,'°',
#1,'³',#25,'2','³', #8,'°', #1,'³',#25, #2, #7,'B','l','o','c','k',
'e','d', #8,':',#25,#10, #1,'³', #8,'°',#24,'°', #1,'³',#25,'2','³',
#8,'°', #1,'³',#25, #2, #7,'R','e','f','u','s','e','d', #8,':',#25,
#10, #1,'³', #8,'°',#24,'°', #1,'³',#25,'2','³', #8,'°', #1,'³',#25,
#4, #7,'T','o','t','a','l', #8,':',#25,#10, #1,'³', #8,'°',#24,'°',
#1,'³',#25,'2','³', #8,'°', #1,'³',#25,#21,'³', #8,'°',#24,'°', #1,
'À',#26,'2','Ä','Ù', #8,'°', #1,'À',#26,#21,'Ä','Ù', #8,'°',#24,#26,
'O','°',#24,'°', #1,'Ú',' ', #7,'S','e','r','v','e','r',' ','S','t',
'a','t','u','s',' ', #1,#26,'<','Ä','¿', #8,'°',#24,'°', #1,'³',#25,
'K','³', #8,'°',#24,'°', #1,'³',#25,'K','³', #8,'°',#24,'°', #1,'³',
#25,'K','³', #8,'°',#24,'°', #1,'³',#25,'K','³', #8,'°',#24,'°', #1,
'³',#25,'K','³', #8,'°',#24,'°', #1,'³',#25,'K','³', #8,'°',#24,'°',
#1,'³',#25,'K','³', #8,'°',#24,'°', #1,'³',#25,'K','³', #8,'°',#24,
'°', #1,'À',#26,'K','Ä','Ù', #8,'°',#24,#26,'O','°',#24,#23,' ', #1,
'T','A','B','/','S','w','i','t','c','h',' ','W','i','n','d','o','w',
#25, #2,'E','N','T','E','R','/','S','n','o','o','p',#25, #2,'S','P',
'A','C','E','/','L','o','c','a','l',#25, #2,'A','L','T','-','K','/',
'K','i','l','l',' ','U','s','e','r',#25, #2,'E','S','C','/','S','h',
'u','t','d','o','w','n',' ',#24);
Begin
Console.LoadScreenImage(ImageData, ImageData_Length, ImageData_Width, 1, 1);
Console.WriteXY (1, 25, 113, strPadC('SPACE/Local TELNET TAB/Switch ESC/Shutdown', 79, ' '));
// Console.WriteXY (25, 1, 113, strPadC(mysVersionText, 30, ' '));
End;

827
mystic/mis_client_ftp.pas Normal file
View File

@ -0,0 +1,827 @@
{$I M_OPS.PAS}
Unit MIS_Client_FTP;
// does not send file/directory datestamps
// does not support uploading (need to make bbs functions generic for this
// and for mbbsutil -fupload command)
Interface
Uses
SysUtils,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
MIS_Common;
Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Type
TFTPServer = Class(TServerClient)
Server : TServerManager;
UserName : String[40];
Password : String[20];
LoggedIn : Boolean;
GotQuit : Boolean;
IsPassive : Boolean;
InTransfer : Boolean;
Cmd : String;
Data : String;
DataPort : Word;
DataIP : String;
DataSocket : TSocketClass;
User : RecUser;
UserPos : LongInt;
FBasePos : LongInt;
FBase : FBaseRec;
SecLevel : RecSecurity;
FileMask : String;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
// Procedure dlog (S:String);
Procedure ResetSession;
Procedure UpdateUserStats (TFBase: FBaseRec; FDir: FDirRec; DirPos: LongInt);
Function CheckFileLimits (TempFBase: FBaseRec; FDir: FDirRec) : Byte;
Function OpenDataSession : Boolean;
Procedure CloseDataSession;
Function ValidDirectory (TempBase: FBaseRec) : Boolean;
Function FindDirectory (Var TempBase: FBaseRec) : LongInt;
Procedure cmdUSER;
Procedure cmdPASS;
Procedure cmdREIN;
Procedure cmdPORT;
Procedure cmdPASV;
Procedure cmdCWD;
Procedure cmdCDUP;
Procedure cmdNLST;
Procedure cmdLIST;
Procedure cmdPWD;
Procedure cmdRETR;
Procedure cmdSTRU;
Procedure cmdMODE;
Procedure cmdSYST;
Procedure cmdTYPE;
Procedure cmdEPRT;
Procedure cmdEPSV;
Procedure cmdSIZE;
End;
Implementation
Const
FTPTimeOut = 120; // Make this configurabe in MCFG?
FileBufSize = 8 * 1024;
re_DataOpen = '125 Data connection already open';
re_DataOpening = '150 File status okay; about to open data connection.';
re_CommandOK = '200 Command okay.';
re_NoCommand = '202 Command not implemented, superfluous at this site.';
re_Greeting = '220 Mystic FTP server ready';
re_Goodbye = '221 Goodbye';
re_DataClosed = '226 Closing data connection.';
re_XferOK = '226 Transfer OK';
re_PassiveOK = '227 Entering Passive Mode ';
re_LoggedIn = '230 User logged in, proceed.';
re_DirOkay = '257 Working directory is now ';
re_UserOkay = '331 User name okay, need password.';
re_NoData = '425 Unable to open data connection';
re_BadCommand = '503 Bad sequence of commands.';
re_UserUnknown = '530 Not logged in.';
re_BadPW = '530 Login or password incorrect';
re_BadDir = '550 Directory change failed';
re_BadFile = '550 File not found';
re_NoAccess = '550 Access denied';
re_DLLimit = '550 Download limit would be exceeded';
re_DLRatio = '550 Download/upload ratio would be exceeded';
Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
Result := TFTPServer.Create(Owner, CliSock);
End;
Constructor TFTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Begin
Inherited Create(Owner, CliSock);
Server := Owner;
End;
(*
Procedure TFTPServer.dlog (S:String);
Var
T : Text;
Begin
Assign (T, 'd:\code\mystic1\misftp.log');
Append (T);
If IoResult <> 0 Then Rewrite(T);
WriteLn(T, S);
Close(T);
End;
*)
Procedure TFTPServer.ResetSession;
Begin
If Assigned(DataSocket) Then DataSocket.Free;
LoggedIn := False;
GotQuit := False;
UserName := '';
Password := '';
UserPos := -1;
DataIP := '';
DataPort := 20;
DataSocket := NIL;
IsPassive := False;
FBasePos := -1;
InTransfer := False;
End;
Procedure TFTPServer.UpdateUserStats (TFBase: FBaseRec; FDir: FDirRec; DirPos: LongInt);
Var
HistFile: File of HistoryRec;
History : HistoryRec;
FDirFile: File of FDirRec;
UserFile: File of RecUser;
Begin
Inc (FDir.DLs);
Assign (UserFile, bbsConfig.DataPath + 'users.dat');
ioReset (UserFile, SizeOf(RecUser), fmReadWrite + fmDenyWrite);
ioSeek (UserFile, UserPos - 1);
ioRead (UserFile, User);
If DateDos2Str(User.LastOn, 1) <> DateDos2Str(CurDateDos, 1) Then Begin
User.CallsToday := 0;
User.DLsToday := 0;
User.DLkToday := 0;
User.TimeLeft := SecLevel.Time
End;
// need to check if it were an upload and do things accordingly
Inc (User.DLs);
Inc (User.DLsToday);
Inc (User.DLk, FDir.Size DIV 1024);
Inc (User.DLkToday, FDir.Size DIV 1024);
ioSeek (UserFile, UserPos - 1);
ioWrite (UserFile, User);
Close (UserFile);
Assign (FDirFile, bbsConfig.DataPath + TFBase.FileName + '.dir');
ioReset (FDirFile, SizeOf(FDirRec), fmReadWrite + fmDenyWrite);
ioSeek (FDirFile, DirPos - 1);
ioWrite (FDirFile, FDir);
Close (FDirFile);
Assign (HistFile, bbsConfig.DataPath + 'history.dat');
ioReset (HistFile, SizeOf(HistoryRec), fmReadWrite + fmDenyWrite);
If IoResult <> 0 Then ReWrite(HistFile);
History.Date := CurDateDos;
While Not Eof(HistFile) Do Begin
ioRead (HistFile, History);
If DateDos2Str(History.Date, 1) = DateDos2Str(CurDateDos, 1) Then Begin
ioSeek (HistFile, FilePos(HistFile) - 1);
Break;
End;
End;
If Eof(HistFile) Then Begin
FillChar(History, SizeOf(History), 0);
History.Date := CurDateDos;
End;
Inc (History.Downloads, 1);
Inc (History.DownloadKB, FDir.Size DIV 1024);
ioWrite (HistFile, History);
Close (HistFile);
End;
Function TFTPServer.CheckFileLimits (TempFBase: FBaseRec; FDir: FDirRec) : Byte;
{ 0 = OK to download }
{ 1 = Offline or Invalid or Failed or NO ACCESS or no file (prompt 224)}
{ 2 = DL per day limit exceeded (prompt 58) }
{ 3 = UL/DL file ratio bad (prompt 211) }
Begin
Result := 1;
If Not FileExist(TempFBase.Path + FDir.Filename) Then Exit;
If Not CheckAccess(User, True, TempFBase.DLACS) Then Exit;
If FDir.Flags And FDirOffline <> 0 Then Exit;
If (FDir.Flags And FDirInvalid <> 0) And Not CheckAccess(User, True, bbsConfig.AcsDLUnvalid) Then Exit;
If (FDir.Flags And FDirFailed <> 0) And Not CheckAccess(User, True, bbsConfig.AcsDLFailed) Then Exit;
If (FDir.Flags And FDirFree <> 0) or (User.Flags and UserNoRatio <> 0) or (TempFBase.IsFREE) Then Begin
Result := 0;
Exit;
End;
If (User.DLsToday + 1 > SecLevel.MaxDLs) and (SecLevel.MaxDLs > 0) Then Begin
Result := 2;
Exit;
End;
If SecLevel.DLRatio > 0 Then
If (User.ULs * SecLevel.DLRatio) <= (User.DLs + 1) Then Begin
Result := 3;
Exit;
End;
If SecLevel.DLKRatio > 0 Then
If (User.ULk * SecLevel.DLkRatio) <= (User.DLk + (FDir.Size DIV 1024)) Then Begin
Result := 3;
Exit;
End;
If (User.DLkToday + (FDir.Size DIV 1024) > SecLevel.MaxDLk) and (SecLevel.MaxDLk > 0) Then Begin
Result := 2;
Exit;
End;
Result := 0;
End;
Function TFTPServer.OpenDataSession : Boolean;
Var
WaitSock : TSocketClass;
Begin
Result := False;
If DataSocket <> NIL Then Begin
Client.WriteLine(re_DataOpen);
Result := True;
Exit;
End;
Client.WriteLine(re_DataOpening);
If IsPassive Then Begin
WaitSock := TSocketClass.Create;
WaitSock.WaitInit(DataPort);
DataSocket := WaitSock.WaitConnection;
If Not Assigned(DataSocket) Then Begin
WaitSock.Free;
Client.WriteLine(re_NoData);
Exit;
End;
WaitSock.Free;
End Else Begin
DataSocket := TSocketClass.Create;
If Not DataSocket.Connect(DataIP, DataPort) Then Begin
Client.WriteLine(re_NoData);
DataSocket.Free;
DataSocket := NIL;
Exit;
End;
End;
Result := True;
End;
Procedure TFTPServer.CloseDataSession;
Begin
If DataSocket <> NIL Then Begin
Client.WriteLine(re_DataClosed);
DataSocket.Free;
DataSocket := NIL;
End;
End;
Function TFTPServer.ValidDirectory (TempBase: FBaseRec) : Boolean;
Begin
Result := CheckAccess(User, True, TempBase.FtpACS) and (TempBase.FtpName <> '');
End;
Function TFTPServer.FindDirectory (Var TempBase: FBaseRec) : LongInt;
Var
FBaseFile : TBufFile;
Found : Boolean;
Begin
Result := FBasePos;
TempBase := FBase;
FileMask := '*.*';
If Not LoggedIn Then Exit;
If Data = '' Then Exit;
If (Pos('*', Data) > 0) or (Pos('.', Data) > 0) Then Begin
FileMask := JustFile(Data);
Data := JustPath(Data);
End;
If Data = '/' Then Begin
Result := -1;
Exit;
End;
If ((Data[1] = '/') or (Data[1] = '\')) Then Delete(Data, 1, 1);
If ((Data[Length(Data)] = '/') or (Data[Length(Data)] = '\')) Then Delete(Data, Length(Data), 1);
If Data = '' Then Exit;
FBaseFile := TBufFile.Create(FileBufSize);
If FBaseFile.Open(bbsConfig.DataPath + 'fbases.dat', fmOpen, fmRWDN, SizeOf(FBaseRec)) Then Begin
Found := False;
While Not FBaseFile.EOF Do Begin
FBaseFile.Read(TempBase);
If (strUpper(TempBase.FtpName) = strUpper(Data)) and ValidDirectory(TempBase) Then Begin
Result := FBaseFile.FilePos;
Found := True;
Break;
End;
End;
End;
FBaseFile.Free;
If Not Found Then Begin
If Pos('-', Data) > 0 Then
FileMask := '*.*'
Else
FileMask := Data;
TempBase := FBase;
Result := FBasePos;
End;
End;
Procedure TFTPServer.cmdUSER;
Begin
ResetSession;
If SearchForUser(Data, User, UserPos) Then Begin
Client.WriteLine(re_UserOkay);
UserName := Data;
End Else
Client.WriteLine(re_UserUnknown);
End;
Procedure TFTPServer.cmdPASS;
Begin
If (UserName = '') or (UserPos = -1) Then Begin
Client.WriteLine(re_BadCommand);
Exit;
End;
If strUpper(Data) = User.Password Then Begin
LoggedIn := True;
Client.WriteLine(re_LoggedIn);
GetSecurityLevel(User.Security, SecLevel);
Server.Server.Status (User.Handle + ' logged in');
End Else
Client.WriteLine(re_BadPW);
End;
Procedure TFTPServer.cmdREIN;
Begin
ResetSession;
Client.WriteLine(re_Greeting);
End;
Procedure TFTPServer.cmdPORT;
Var
Count : Byte;
Begin
If LoggedIn Then Begin
For Count := 1 to 3 Do
Data[Pos(',', Data)] := '.';
DataIP := Copy(Data, 1, Pos(',', Data) - 1);
Delete (Data, 1, Pos(',', Data));
WordRec(DataPort).Hi := strS2I(Copy(Data, 1, Pos(',', Data) - 1));
WordRec(DataPort).Lo := strS2I(Copy(Data, Pos(',', Data) + 1, Length(Data)));
Client.WriteLine(re_CommandOK);
IsPassive := False;
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdPASV;
Var
WaitSock : TSocketClass;
Begin
If LoggedIn Then Begin
DataPort := Random(65535-60000) + 60000; // make configurable?!
Client.WriteLine(re_PassiveOK + '(' + strReplace(Client.HostIP, '.', ',') + ',' + strI2S(WordRec(DataPort).Hi) + ',' + strI2S(WordRec(DataPort).Lo) + ').');
IsPassive := True;
WaitSock := TSocketClass.Create;
WaitSock.WaitInit(DataPort);
DataSocket := WaitSock.WaitConnection;
If Not Assigned(DataSocket) Then Begin
WaitSock.Free;
Client.WriteLine(re_NoData);
Exit;
End;
WaitSock.Free;
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdCDUP;
Begin
Client.WriteLine(re_DirOkay + '"/"');
FBasePos := -1;
End;
Procedure TFTPServer.cmdCWD;
Var
TempBase : FBaseRec;
TempPos : LongInt;
Begin
If LoggedIn Then Begin
If (Data = '/') or (Copy(Data, 1, 2) = '..') Then Begin
FBasePos := -1;
Client.WriteLine(re_DirOkay + '"/"');
Exit;
End;
TempPos := FindDirectory(TempBase);
If TempPos = -1 Then Begin
Client.WriteLine(re_BadDir);
Exit;
End;
Client.WriteLine(re_DirOkay + '"/' + TempBase.FtpName + '"');
FBase := TempBase;
FBasePos := TempPos;
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdNLST;
Var
TempBase : FBaseRec;
TempPos : LongInt;
DirFile : TBufFile;
Dir : FDirRec;
Begin
If LoggedIn Then Begin
TempPos := FindDirectory(TempBase);
If TempPos = -1 Then Begin
OpenDataSession;
CloseDataSession;
// list files in root directory, so show nothing
Exit;
End;
OpenDataSession;
DirFile := TBufFile.Create(FileBufSize);
If DirFile.Open(bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN, SizeOf(FDirRec)) Then Begin
While Not DirFile.EOF Do Begin
DirFile.Read(Dir);
If (Dir.Flags And FDirDeleted <> 0) Then Continue;
If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeUnvalid)) Then Continue;
If (Dir.Flags And FDirFailed <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeFailed)) Then Continue;
If WildcardMatch(FileMask, Dir.FileName) Then
DataSocket.WriteLine(Dir.FileName);
End;
End;
DirFile.Free;
CloseDataSession;
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdPWD;
Begin
If LoggedIn Then Begin
If FBasePos = -1 Then
Client.WriteLine(re_DirOkay + '"/"')
Else
Client.WriteLine(re_DirOkay + '"/' + FBase.FtpName + '"');
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdLIST;
Var
TempBase : FBaseRec;
TempPos : LongInt;
FBaseFile : TBufFile;
DirFile : TBufFile;
Dir : FDirRec;
Begin
If LoggedIn Then Begin
TempPos := FindDirectory(TempBase);
If TempPos = -1 Then Begin
OpenDataSession;
FBaseFile := TBufFile.Create(FileBufSize);
If FBaseFile.Open(bbsConfig.DataPath + 'fbases.dat', fmOpen, fmRWDN, SizeOf(FBaseRec)) Then Begin
While Not FBaseFile.EOF Do Begin
FBaseFile.Read(TempBase);
If ValidDirectory(TempBase) and WildcardMatch(FileMask, TempBase.FtpName) Then
DataSocket.WriteLine('drwxr-xr-x 1 ftp ftp 0 Jul 11 23:35 ' + TempBase.FtpName)
End;
End;
FBaseFile.Free;
CloseDataSession;
Exit;
End;
OpenDataSession;
DirFile := TBufFile.Create(FileBufSize);
If DirFile.Open(bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN, SizeOf(FDirRec)) Then Begin
While Not DirFile.EOF Do Begin
DirFile.Read(Dir);
If (Dir.Flags And FDirDeleted <> 0) Then Continue;
If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeUnvalid)) Then Continue;
If (Dir.Flags And FDirFailed <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeFailed)) Then Continue;
If WildcardMatch(FileMask, Dir.FileName) Then
DataSocket.WriteLine('-rw-r--r-- 1 ftp ftp ' + strPadL(strI2S(Dir.Size), 13, ' ') + ' Jul 11 23:35 ' + Dir.FileName)
End;
End;
DirFile.Free;
CloseDataSession;
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdRETR;
Var
TempPos : LongInt;
TempBase : FBaseRec;
DirFile : TBufFile;
Dir : FDirRec;
Found : LongInt;
F : File;
Buf : Array[1..4096] of Byte;
Tmp : LongInt;
Res : LongInt;
Begin
If LoggedIn Then Begin
TempPos := FindDirectory(TempBase);
If TempPos = -1 Then Begin
Client.WriteLine(re_BadFile);
Exit;
End;
DirFile := TBufFile.Create(FileBufSize);
Found := -1;
If DirFile.Open(bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN, SizeOf(FDirRec)) Then Begin
While Not DirFile.EOF Do Begin
DirFile.Read(Dir);
If WildcardMatch(FileMask, Dir.FileName) Then Begin
Found := DirFile.FilePos;
Break;
End;
End;
DirFile.Free;
If Found = -1 Then Begin
Client.WriteLine(re_BadFile);
Exit;
End;
Case CheckFileLimits(TempBase, Dir) of
0 : Begin
Assign (F, TempBase.Path + Dir.FileName);
ioReset (F, 1, fmRWDN);
InTransfer := True;
OpenDataSession;
While Not Eof(F) Do Begin
BlockRead (F, Buf, SizeOf(Buf), Res);
Repeat
Tmp := DataSocket.WriteBuf(Buf, Res);
Dec (Res, Tmp);
Until Res = 0;
End;
Close (F);
Client.WriteLine (re_XferOK);
CloseDataSession;
InTransfer := False;
UpdateUserStats(TempBase, Dir, Found);
End;
1 : Client.WriteLine(re_NoAccess);
2 : Client.WriteLine(re_DLLimit);
3 : Client.WriteLine(re_DLRatio);
End;
End Else
Client.WriteLine(re_BadFile);
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdSTRU;
Begin
If strUpper(Data) = 'F' Then
Client.WriteLine('200 FILE structure.')
Else
Client.WriteLine('504 Only FILE structure supported.');
End;
Procedure TFTPServer.cmdMODE;
Begin
If strUpper(Data) = 'S' Then
Client.WriteLine('200 STREAM mode.')
Else
Client.WriteLine('504 Only STREAM mode supported.');
End;
Procedure TFTPServer.cmdSYST;
Begin
Client.WriteLine('215 UNIX Type: L8');
End;
Procedure TFTPServer.cmdTYPE;
Begin
Client.WriteLine('200 All files sent in BINARY mode.');
End;
Procedure TFTPServer.cmdEPRT;
Var
DataType : String;
Begin
If LoggedIn Then Begin
DataType := strWordGet(1, Data, '|');
If DataType = '1' Then Begin
DataIP := strWordGet(2, Data, '|');
DataPort := strS2I(strWordGet(3, Data, '|'));
IsPassive := False;
Client.WriteLine(re_CommandOK);
End Else
Client.WriteLine('522 Network protocol not supported, use (1)');
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdEPSV;
Var
WaitSock : TSocketClass;
Begin
If LoggedIn Then Begin
If Data = '' Then Begin
DataPort := Random(65535 - 60000) + 60000; // make configuratable
IsPassive := True;
Client.WriteLine('229 Entering Extended Passive Mode (|||' + strI2S(DataPort) + '|)');
WaitSock := TSocketClass.Create;
WaitSock.WaitInit(DataPort);
DataSocket := WaitSock.WaitConnection;
If Not Assigned(DataSocket) Then Begin
WaitSock.Free;
Client.WriteLine(re_NoData);
Exit;
End;
WaitSock.Free;
End Else
If Data = '1' Then
Client.WriteLine(re_CommandOK)
Else
Client.WriteLine('522 Network protocol not supported, use (1)');
End Else
Client.WriteLine(re_BadCommand);
End;
Procedure TFTPServer.cmdSIZE;
Begin
Client.WriteLine('550 Not implemented');
End;
Procedure TFTPServer.Execute;
Var
Str : String;
Begin
cmdREIN;
Repeat
If Client.WaitForData(FTPTimeOut * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
// dlog(Str);
//server.server.status(str);
Cmd := strUpper(strWordGet(1, Str, ' '));
If Pos(' ', Str) > 0 Then
Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
Else
Data := '';
If Cmd = 'CDUP' Then cmdCDUP Else
If Cmd = 'CWD' Then cmdCWD Else
If Cmd = 'EPRT' Then cmdEPRT Else
If Cmd = 'EPSV' Then cmdEPSV Else
If Cmd = 'LIST' Then cmdLIST Else
If Cmd = 'MODE' Then cmdMODE Else
If Cmd = 'NLST' Then cmdNLST Else
If Cmd = 'NOOP' Then Client.WriteLine(re_CommandOK) Else
If Cmd = 'PASS' Then cmdPASS Else
If Cmd = 'PASV' Then cmdPASV Else
If Cmd = 'PORT' Then cmdPORT Else
If Cmd = 'PWD' Then cmdPWD ELse
If Cmd = 'REIN' Then cmdREIN Else
If Cmd = 'RETR' Then cmdRETR Else
If Cmd = 'SIZE' Then cmdSIZE Else
If Cmd = 'STRU' Then cmdSTRU Else
If Cmd = 'SYST' Then cmdSYST Else
If Cmd = 'TYPE' Then cmdTYPE Else
If Cmd = 'USER' Then cmdUSER Else
If Cmd = 'XPWD' Then cmdPWD Else
If Cmd = 'QUIT' Then Begin
GotQuit := True;
Break;
End Else
Client.WriteLine(re_NoCommand);
Until Terminated;
If GotQuit Then Begin
Client.WriteLine(re_Goodbye);
Server.Server.Status (User.Handle + ' logged out');
End;
End;
Destructor TFTPServer.Destroy;
Begin
If Assigned(DataSocket) Then DataSocket.Free;
Inherited Destroy;
End;
End.

141
mystic/mis_client_http.pas Normal file
View File

@ -0,0 +1,141 @@
{$I M_OPS.PAS}
Unit MIS_Client_POP3;
Interface
Uses
SysUtils,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
MIS_Common;
Function CreatePOP3 (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Type
TPOP3Server = Class(TServerClient)
Server : TServerManager;
UserName : String[40];
Password : String[20];
LoggedIn : Boolean;
Cmd : String;
Data : String;
User : UserRec;
UserPos : LongInt;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
Procedure ResetSession;
Procedure cmdUSER;
Procedure cmdPASS;
End;
Implementation
Const
POP3TimeOut = 120;
FileBufSize = 8 * 1024;
re_OK = '+OK ';
re_Error = '-ERR ';
re_UnknownCommand = re_Error + 'Unknown command';
re_UnknownUser = re_Error + 'Unknown user';
re_BadLogin = re_Error + 'Bad credentials';
re_Greeting = 'Mystic POP3 Server';
re_Goodbye = re_OK + 'Goodbye';
re_SendUserPass = re_OK + 'Send user password';
re_LoggedIn = re_OK + 'Welcome';
Function CreatePOP3 (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
Result := TPOP3Server.Create(Owner, CliSock);
End;
Constructor TPOP3Server.Create (Owner: TServerManager; CliSock: TSocketClass);
Begin
Inherited Create(Owner, CliSock);
Server := Owner;
End;
Procedure TPOP3Server.ResetSession;
Begin
LoggedIn := False;
UserName := '';
Password := '';
UserPos := -1;
End;
Procedure TPOP3Server.cmdUSER;
Begin
ResetSession;
If SearchForUser(Data, User, UserPos) Then Begin
Client.WriteLine(re_SendUserPass);
UserName := Data;
End Else
Client.WriteLine(re_UnknownUser);
End;
Procedure TPOP3Server.cmdPASS;
Begin
If (UserName = '') or (UserPos = -1) Then Begin
Client.WriteLine(re_UnknownUser);
Exit;
End;
If strUpper(Data) = User.Password Then Begin
LoggedIn := True;
Client.WriteLine(re_LoggedIn);
End Else
Client.WriteLine(re_BadLogin);
End;
Procedure TPOP3Server.Execute;
Var
Str : String;
Begin
ResetSession;
Client.WriteLine(re_Greeting);
Repeat
If Client.WaitForData(POP3TimeOut * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
server.server.status(str);
Cmd := strUpper(strWordGet(1, Str, ' '));
If Pos(' ', Str) > 0 Then
Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
Else
Data := '';
If Cmd = 'PASS' Then cmdPASS Else
If Cmd = 'QUIT' Then Break Else
If Cmd = 'USER' Then cmdUSER Else
Client.WriteLine(re_UnknownCommand);
Until Terminated;
If Not Terminated Then Client.WriteLine(re_Goodbye);
End;
Destructor TPOP3Server.Destroy;
Begin
Inherited Destroy;
End;
End.

146
mystic/mis_client_nntp.pas Normal file
View File

@ -0,0 +1,146 @@
{$I M_OPS.PAS}
Unit MIS_Client_NNTP;
// lookup:
// how to send greeting and goodbye?
// how to send capabilities so far only AUTHINFO
// determine base feature-set required
Interface
Uses
SysUtils,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
MIS_Common;
Function CreateNNTP (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Type
TNNTPServer = Class(TServerClient)
Server : TServerManager;
UserName : String[40];
Password : String[20];
LoggedIn : Boolean;
Cmd : String;
Data : String;
User : RecUser;
UserPos : LongInt;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
Procedure ResetSession;
Procedure cmd_AUTHINFO;
End;
Implementation
Const
NNTPTimeOut = 180; // make configurable
re_Greeting = 'Mystic BBS NNTP Server';
re_Goodbye = 'Goodbye';
re_AuthOK = '281 Authentication accepted';
re_AuthBad = '381 Authentication rejected';
re_AuthPass = '381 Password required';
re_AuthSync = '482 Bad Authentication sequence';
re_Unknown = '500 Unknown command';
re_UnknownOption = '501 Unknown option';
Function CreateNNTP (Owner: TServerManager; 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.ResetSession;
Begin
LoggedIn := False;
UserName := '';
Password := '';
UserPos := -1;
End;
Procedure TNNTPServer.cmd_AUTHINFO;
Var
NewCmd : String;
NewData : String;
Begin
ResetSession;
NewCmd := strWordGet(1, Data, ' ');
NewData := Copy(Data, Pos(' ', Data) + 1, 255);
If NewCmd = 'USER' Then Begin
If SearchForUser(NewData, User, UserPos) Then Begin
Client.WriteLine(re_AuthPass);
UserName := NewData;
End Else
Client.WriteLine(re_AuthBad);
End Else
If NewCmd = 'PASS' Then Begin
If UserPos = -1 Then
Client.WriteLine(re_AuthSync)
Else
If strUpper(NewData) = User.Password Then Begin
Client.WriteLine(re_AuthOK);
LoggedIn := True;
End Else
Client.WriteLine(re_AuthBad);
End Else
Client.WriteLine(re_UnknownOption);
End;
Procedure TNNTPServer.Execute;
Var
Str : String;
Begin
ResetSession;
Client.WriteLine(re_Greeting);
Repeat
If Client.WaitForData(NNTPTimeOut * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
//server.server.status(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 = 'QUIT' Then Break Else
Client.WriteLine(re_Unknown);
Until Terminated;
If Not Terminated Then Client.WriteLine(re_Goodbye);
End;
Destructor TNNTPServer.Destroy;
Begin
Inherited Destroy;
End;
End.

497
mystic/mis_client_pop3.pas Normal file
View File

@ -0,0 +1,497 @@
{$I M_OPS.PAS}
Unit MIS_Client_POP3;
// RFC 1939
// optional TOP and APOP not implemented
// needs to reformat long messages > 79 chars?
Interface
Uses
MD5,
Classes,
SysUtils,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
MIS_Common,
BBS_MsgBase_ABS,
BBS_MsgBase_JAM,
BBS_MsgBase_Squish;
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Const
MaxMailBoxSize = 1000;
Type
PMailMessageRec = ^TMailMessageRec;
TMailMessageRec = Record
MsgSize : LongInt;
MD5 : String[32];
Deleted : Boolean;
GotRETR : Boolean;
Text : TStringList;
End;
TPOP3Server = Class(TServerClient)
Server : TServerManager;
UserName : String[40];
Password : String[20];
LoggedIn : Boolean;
GotQuit : Boolean;
Cmd : String;
Data : String;
User : RecUser;
UserPos : LongInt;
MailInfo : Array[1..MaxMailBoxSize] of PMailMessageRec;
MailSize : LongInt;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
Procedure ResetSession;
Procedure CreateMailBoxData;
Procedure DeleteMessages;
Function GetMessageUID (Var MsgBase: PMsgBaseABS) : String;
Procedure GetMessageCount (Var TotalMsg: LongInt; Var TotalSize: LongInt);
Procedure cmdLIST;
Procedure cmdUSER;
Procedure cmdPASS;
Procedure cmdSTAT;
Procedure cmdUIDL;
Procedure cmdRETR;
Procedure cmdRSET;
Procedure cmdDELE;
Procedure cmdTOP;
End;
Implementation
Const
POP3TimeOut : SmallInt = 900; { MCFG? }
DeleteOnRETR : Boolean = False; { MCFG? }
re_OK = '+OK ';
re_Error = '-ERR ';
re_UnknownCommand = re_Error + 'Unknown command';
re_UnknownUser = re_Error + 'Unknown user';
re_BadLogin = re_Error + 'Bad credentials';
re_NotLoggedIn = re_Error + 'Not logged in';
re_UnknownMail = re_Error + 'Unknown message';
re_Greeting = re_OK + 'Mystic POP3 Server';
re_Goodbye = re_OK + 'Goodbye';
re_SendUserPass = re_OK + 'Send user password';
re_LoggedIn = re_OK + 'Welcome';
re_GetMessage = re_OK + 'Sending message ';
re_ResetOK = re_OK + 'Messages reset';
re_MsgDeleted = re_OK + 'Message deleted';
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
Result := TPOP3Server.Create(Owner, CliSock);
End;
Constructor TPOP3Server.Create (Owner: TServerManager; CliSock: TSocketClass);
Begin
Inherited Create(Owner, CliSock);
Server := Owner;
MailSize := 0;
End;
Procedure TPOP3Server.ResetSession;
Var
Count : LongInt;
Begin
LoggedIn := False;
GotQuit := False;
UserName := '';
Password := '';
UserPos := -1;
For Count := 1 to MailSize Do
If MailInfo[Count] <> NIL Then Begin
If Assigned(MailInfo[Count].Text) Then
MailInfo[Count].Text.Free;
Dispose (MailInfo[Count]);
End;
MailSize := 0;
End;
Procedure TPOP3Server.GetMessageCount (Var TotalMsg: LongInt; Var TotalSize: LongInt);
Var
Count : LongInt;
Begin
TotalMsg := 0;
TotalSize := 0;
For Count := 1 to MailSize Do
If Not MailInfo[Count].Deleted Then Begin
Inc (TotalMsg);
Inc (TotalSize, MailInfo[Count].MsgSize);
End;
End;
Function TPOP3Server.GetMessageUID (Var MsgBase: PMsgBaseABS) : String;
Var
TempStr : String;
Begin
// FP might calc this wrong if we do it all at once, so annoying
TempStr := strI2S(User.PermIdx);
TempStr := TempStr + MsgBase^.GetFrom;
TempStr := TempStr + MsgBase^.GetDate;
TempStr := TempStr + MsgBase^.GetTime;
Result := MD5Print(MD5String(TempStr));
End;
Procedure TPOP3Server.CreateMailBoxData;
Var
MBaseFile : File of MBaseRec;
MBase : MBaseRec;
MsgBase : PMsgBaseABS;
Function ParseDateTime (Date, Time : String) : String;
Begin
DateSeparator := '-';
ParseDateTime := FormatDateTime('ddd, dd mmm yyyy hh:nn:ss', StrToDateTime(Date + ' ' + Time));
End;
Procedure AddLine (Str: String);
Begin
MailInfo[MailSize].Text.Add(Str);
Inc (MailInfo[MailSize].MsgSize, Length(Str) + 2); {CRLF}
End;
Begin
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
If Not ioReset(MBaseFile, SizeOf(MBaseRec), fmRWDN) Then Exit;
ioRead (MBaseFile, MBase);
Close (MBaseFile);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If Not MsgBase^.OpenMsgBase Then Begin
Dispose (MsgBase, Done);
Exit;
End;
MsgBase^.YoursFirst(User.RealName, User.Handle);
While MsgBase^.YoursFound Do Begin
MsgBase^.MsgStartup;
MsgBase^.MsgTxtStartup;
Inc (MailSize);
New (MailInfo[MailSize]);
MailInfo[MailSize].Text := TStringList.Create;
AddLine ('Date: ' + ParseDateTime(MsgBase^.GetDate, MsgBase^.GetTime));
AddLine ('From: ' + MsgBase^.GetFrom + ' <' + strReplace(MsgBase^.GetFrom, ' ', '_') + '@' + bbsConfig.inetDomain + '>');
AddLine ('X-Mailer: Mystic BBS ' + mysVersion);
AddLine ('To: ' + MsgBase^.GetTo + ' <' + strReplace(MsgBase^.GetTo, ' ', '_') + '@' + bbsConfig.inetDomain + '>');
AddLine ('Subject: ' + MsgBase^.GetSubj);
AddLine ('Content-Type: text/plain; charset=us-ascii');
AddLine ('');
While Not MsgBase^.EOM Do
AddLine(MsgBase^.GetString(79));
MailInfo[MailSize].MD5 := GetMessageUID(MsgBase);
MailInfo[MailSize].GotRETR := False;
MailInfo[MailSize].Deleted := False;
MsgBase^.YoursNext;
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
End;
Procedure TPOP3Server.DeleteMessages;
Var
Count : LongInt;
MBaseFile : File of MBaseRec;
MBase : MBaseRec;
MsgBase : PMsgBaseABS;
Begin
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
If Not ioReset(MBaseFile, SizeOf(MBaseRec), fmRWDN) Then Exit;
ioRead (MBaseFile, MBase);
Close (MBaseFile);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If Not MsgBase^.OpenMsgBase Then Begin
Dispose (MsgBase, Done);
Exit;
End;
For Count := 1 to MailSize Do Begin
If MailInfo[Count].Deleted or (MailInfo[Count].GotRETR and DeleteOnRETR) Then Begin
MsgBase^.YoursFirst(User.RealName, User.Handle);
While MsgBase^.YoursFound Do Begin
MsgBase^.MsgStartUp;
If GetMessageUID(MsgBase) = MailInfo[Count].MD5 Then Begin
MsgBase^.DeleteMsg;
Break;
End;
MsgBase^.YoursNext;
End;
End;
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
End;
Procedure TPOP3Server.cmdUSER;
Begin
ResetSession;
If SearchForUser(Data, User, UserPos) Then Begin
Client.WriteLine(re_SendUserPass);
UserName := Data;
End Else
Client.WriteLine(re_UnknownUser);
End;
Procedure TPOP3Server.cmdPASS;
Begin
If (UserName = '') or (UserPos = -1) Then Begin
Client.WriteLine(re_UnknownUser);
Exit;
End;
If strUpper(Data) = User.Password Then Begin
LoggedIn := True;
CreateMailboxData;
Client.WriteLine(re_LoggedIn);
Server.Server.Status(User.Handle + ' logged in');
End Else
Client.WriteLine(re_BadLogin);
End;
Procedure TPOP3Server.cmdSTAT;
Var
DataSize : LongInt;
DataMsg : LongInt;
Begin
If LoggedIn Then Begin
GetMessageCount(DataMsg, DataSize);
Client.WriteLine(re_OK + strI2S(DataMsg) + ' ' + strI2O(Datasize));
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdLIST;
Var
MsgNum : LongInt;
MsgSize : LongInt;
Count : LongInt;
Begin
If LoggedIn Then Begin
If Data <> '' Then Begin
MsgNum := strS2I(Data);
If (MsgNum > 0) and (MsgNum <= MailSize) and (Not MailInfo[MsgNum].Deleted) Then
Client.WriteLine(re_OK + strI2S(MsgNum) + ' ' + strI2O(MailInfo[MsgNum].MsgSize))
Else
Client.WriteLine(re_UnknownMail);
End Else Begin
GetMessageCount(MsgNum, MsgSize);
Client.WriteLine (re_OK + strI2S(MsgNum) + ' messages (' + strI2O(MsgSize) + ' octets)');
For Count := 1 to MailSize Do
If Not MailInfo[Count].Deleted Then
Client.WriteLine (strI2S(Count) + ' ' + strI2O(MailInfo[Count].MsgSize));
Client.WriteLine('.');
End;
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdUIDL;
Var
MsgNum : LongInt;
Count : LongInt;
Begin
If LoggedIn Then Begin
If Data <> '' Then Begin
MsgNum := strS2I(Data);
If (MsgNum > 0) and (MsgNum <= MailSize) and (Not MailInfo[MsgNum].Deleted) Then
Client.WriteLine(re_OK + strI2S(MsgNum) + ' ' + MailInfo[MsgNum].MD5)
Else
Client.WriteLine(re_UnknownMail);
End Else Begin
Client.WriteLine (re_OK + 'Message list follows');
For Count := 1 to MailSize Do
If Not MailInfo[Count].Deleted Then Begin
Client.WriteLine (strI2S(Count) + ' ' + MailInfo[Count].MD5);
End;
Client.WriteLine('.');
End;
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdRETR;
Var
MsgNum : LongInt;
Count : LongInt;
Begin
If LoggedIn Then Begin
MsgNum := strS2I(Data);
If (MsgNum > 0) and (MsgNum <= MailSize) and (Not MailInfo[MsgNum].Deleted) Then Begin
Client.WriteLine (re_GetMessage + strI2S(MsgNum));
For Count := 0 to MailInfo[MsgNum].Text.Count - 1 Do
Client.WriteLine(MailInfo[MsgNum].Text[Count]);
Client.WriteLine('.');
MailInfo[MsgNum].GotRETR := True;
End Else
Client.WriteLine(re_UnknownMail);
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdRSET;
Var
Count : LongInt;
Begin
If LoggedIn Then Begin
For Count := 1 to MailSize Do
MailInfo[Count].Deleted := False;
Client.WriteLine (re_ResetOK);
End Else
Client.WriteLine (re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdDELE;
Var
MsgNum : LongInt;
Begin
If LoggedIn Then Begin
MsgNum := strS2I(Data);
If (MsgNum > 0) and (MsgNum <= MailSize) and (Not MailInfo[MsgNum].Deleted) Then Begin
MailInfo[MsgNum].Deleted := True;
Client.WriteLine(re_MsgDeleted);
End Else
Client.WriteLine(re_UnknownMail);
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.cmdTOP;
Begin
If LoggedIn Then Begin
End Else
Client.WriteLine(re_NotLoggedIn);
End;
Procedure TPOP3Server.Execute;
Var
Str : String;
Begin
ResetSession;
Client.WriteLine(re_Greeting);
Repeat
If Client.WaitForData(POP3TimeOut * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
Cmd := strUpper(strWordGet(1, Str, ' '));
If Pos(' ', Str) > 0 Then
Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
Else
Data := '';
// If Cmd = 'APOP' Then cmdAPOP Else
If Cmd = 'DELE' Then cmdDELE Else
If Cmd = 'LIST' Then cmdLIST Else
If Cmd = 'NOOP' Then Client.WriteLine(re_OK) Else
If Cmd = 'PASS' Then cmdPASS Else
If Cmd = 'RETR' Then cmdRETR Else
If Cmd = 'RSET' Then cmdRSET Else
If Cmd = 'STAT' Then cmdSTAT Else
// If Cmd = 'TOP' Then cmdTOP Else
If Cmd = 'UIDL' Then cmdUIDL Else
If Cmd = 'USER' Then cmdUSER Else
If Cmd = 'QUIT' Then Begin
GotQuit := True;
Break;
End Else
Client.WriteLine(re_UnknownCommand);
Until Terminated;
If GotQuit Then Begin
Client.WriteLine(re_Goodbye);
Server.Server.Status (User.Handle + ' logged out');
DeleteMessages;
End;
End;
Destructor TPOP3Server.Destroy;
Begin
ResetSession;
Inherited Destroy;
End;
End.

329
mystic/mis_client_smtp.pas Normal file
View File

@ -0,0 +1,329 @@
{$I M_OPS.PAS}
Unit MIS_Client_SMTP;
{ update e-mails post stats }
{ update bbs history }
Interface
Uses
Classes,
SysUtils,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
bbs_MsgBase_Squish,
MIS_Server,
MIS_NodeData,
MIS_Common;
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Type
TSMTPServer = Class(TServerClient)
Server : TServerManager;
User : RecUser;
UserPos : LongInt;
Cmd : String;
Data : String;
EndSession : Boolean;
FromName : String;
FromPos : LongInt;
ToList : TStringList;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
Procedure ResetSession;
Function ValidateNameAndDomain (IsFrom: Boolean) : Boolean;
Procedure cmdHELO;
Procedure cmdRSET;
Procedure cmdMAIL;
Procedure cmdRCPT;
Procedure cmdDATA;
End;
Implementation
Const
SMTPTimeOut = 120; { MCFG }
SMTPHackThresh = 10000;
re_Goodbye = '221 Goodbye';
re_UnknownCmd = '502 Unknown command';
re_OK = '250 OK';
re_BadUser = '550 No such user here';
re_NeedMail = '503 Must send MAIL FROM: first';
re_NeedRcpt = '503 Must send RCPT TO: first';
re_ErrorSending = '550 Mailbox not found';
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
Result := TSMTPServer.Create(Owner, CliSock);
End;
Constructor TSMTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Begin
Inherited Create(Owner, CliSock);
Server := Owner;
End;
Function TSMTPServer.ValidateNameAndDomain (IsFrom: Boolean) : Boolean;
Var
InName : String;
InDomain : String;
Begin
Result := False;
InName := strReplace(Copy(Data, Pos('<', Data) + 1, Pos('@', Data) - Pos('<', Data) - 1), '_', ' ');
InDomain := Copy(Data, Pos('@', Data) + 1, Pos('>', Data) - Pos('@', Data) - 1);
If IsFrom Then
Server.Server.Status('User: ' + InName + ' Domain: ' + InDomain);
If InDomain <> bbsConfig.iNetDomain Then Begin
Server.Server.Status('Refused by domain: ' + InName + '@' + InDomain);
Exit;
End;
Result := SearchForUser(InName, User, UserPos);
If Not Result Then
Server.Server.Status('Refused by name: ' + InName + '@' + InDomain);
End;
Procedure TSMTPServer.ResetSession;
Begin
UserPos := -1;
FromName := '';
FromPos := -1;
EndSession := False;
If Assigned(ToList) Then ToList.Free;
ToList := TStringList.Create;
End;
Procedure TSMTPServer.cmdHELO;
Begin
Client.WriteLine('250 ' + bbsConfig.inetDomain);
End;
Procedure TSMTPServer.cmdRSET;
Begin
ResetSession;
Client.WriteLine(re_OK);
End;
Procedure TSMTPServer.cmdMAIL;
Begin
If ValidateNameAndDomain(True) Then Begin
FromName := User.Handle;
Client.WriteLine (re_OK)
End Else
Client.WriteLine (re_BadUser);
End;
Procedure TSMTPServer.cmdRCPT;
Begin
If FromName = '' Then Begin
Client.WriteLine (re_NeedMail);
Exit;
End;
If ValidateNameAndDomain(False) Then Begin
ToList.Add(User.Handle);
Client.WriteLine (re_OK);
End Else
Client.WriteLine (re_BadUser);
End;
Procedure TSMTPServer.cmdDATA;
Var
InData : String;
HackCount : LongInt;
MBaseFile : File of MBaseRec;
MBase : MBaseRec;
MsgBase : PMsgBaseABS;
MsgText : TStringList;
MsgSubject : String;
MsgLoop : LongInt;
Count : LongInt;
Count2 : LongInt;
Str : String;
Begin
If FromName = '' Then Begin
Client.WriteLine (re_NeedMail);
Exit;
End;
If ToList.Count = 0 Then Begin
Client.WriteLine (re_NeedRcpt);
Exit;
End;
Client.WriteLine ('354 Start mail input; end with <CRLF>.<CRLF>');
MsgText := TStringList.Create;
Repeat
Client.ReadLine(InData);
If InData = '.' Then Break;
If MsgText.Count >= mysMaxMsgLines Then Begin
HackCount := 0;
While Not Terminated And (InData <> '.') Do Begin
// todo: what happens if they never send an EOL... could still flood
Client.ReadLine(InData);
Inc (HackCount);
If HackCount >= SMTPHackThresh Then Begin
EndSession := True; // someone is being a douchebag
Server.Server.Status('Flood attempt from ' + FromName + ' (' + Client.PeerIP + '); Goodbye');
MsgText.Free;
Exit;
End;
End;
Break;
End;
MsgText.Add(InData);
Until False;
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
ioReset (MBaseFile, SizeOf(MBaseRec), fmRWDN);
ioRead (MBaseFile, MBase);
Close (MBaseFile);
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If Not MsgBase^.OpenMsgBase Then
If Not MsgBase^.CreateMsgBase (MBase.MaxMsgs, MBase.MaxAge) Then Begin
Dispose(MsgBase, Done);
MsgText.Free;
Client.WriteLine(re_ErrorSending);
Exit;
End Else
If Not MsgBase^.OpenMsgBase Then Begin
Dispose(MsgBase, Done);
MsgText.Free;
Client.WriteLine(re_ErrorSending);
Exit;
End;
MsgSubject := '';
Count := 0;
While Count < MsgText.Count Do Begin
If Pos('Subject:', MsgText.Strings[Count]) > 0 Then
MsgSubject := Copy(MsgText.Strings[Count], 10, Length(MsgText.Strings[Count]))
Else
If MsgText.Strings[Count] = '' Then Begin
While (MsgText.Strings[Count] = '') And (Count < MsgText.Count) Do Inc(Count);
Break;
End;
Inc (Count);
End;
If Count = MsgText.Count Then Begin
Client.WriteLine(re_ErrorSending);
MsgText.Free;
Exit;
End;
For MsgLoop := 0 To ToList.Count - 1 Do Begin
Server.Server.Status('Sending mail from ' + FromName + ' to ' + ToList.Strings[MsgLoop]);
MsgBase^.StartNewMsg;
MsgBase^.SetLocal (True);
MsgBase^.SetMailType (mmtNormal);
MsgBase^.SetPriv (True);
MsgBase^.SetDate (FormatDateTime('mm/dd/yy', Now));
MsgBase^.SetTime (FormatDateTime('hh:nn', Now));
MsgBase^.SetFrom (FromName);
MsgBase^.SetTo (ToList.Strings[MsgLoop]);
MsgBase^.SetSubj (MsgSubject);
For Count2 := Count to MsgText.Count - 1 Do Begin
Str := MsgText.Strings[Count2];
If Length(Str) > 79 Then Str[0] := #79;
MsgBase^.DoStringLn(Str);
End;
MsgBase^.WriteMsg;
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
Client.WriteLine(re_OK);
End;
Procedure TSMTPServer.Execute;
Var
Str : String;
Begin
ResetSession;
Client.WriteLine('220 ' + bbsConfig.iNetDomain + ' Mystic SMTP Ready');
Repeat
If Client.WaitForData(SMTPTimeOut * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
Cmd := strUpper(strWordGet(1, Str, ' '));
If Pos(' ', Str) > 0 Then
Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
Else
Data := '';
If Cmd = 'DATA' Then cmdDATA Else
If Cmd = 'EHLO' Then cmdHELO Else
If Cmd = 'HELO' Then cmdHELO Else
If Cmd = 'MAIL' Then cmdMAIL Else
If Cmd = 'NOOP' Then Client.WriteLine(re_OK) Else
If Cmd = 'RCPT' Then cmdRCPT Else
If Cmd = 'RSET' Then cmdRSET Else
If Cmd = 'QUIT' Then Break Else
Client.WriteLine(re_UnknownCmd);
Until Terminated or EndSession;
If Not Terminated And Not EndSession Then Client.WriteLine(re_Goodbye);
End;
Destructor TSMTPServer.Destroy;
Begin
If Assigned(ToList) Then ToList.Free;
Inherited Destroy;
End;
End.

135
mystic/mis_client_telnet.pas Normal file
View File

@ -0,0 +1,135 @@
{$I M_OPS.PAS}
Unit MIS_Client_Telnet;
Interface
Uses
{$IFDEF UNIX}
Unix,
{$ENDIF}
{$IFDEF WIN32}
Windows,
{$ENDIF}
m_Strings,
m_Socket_Class,
MIS_Common,
MIS_NodeData,
MIS_Server;
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
{ must match server create or there will be access violations }
Type
TTelnetServer = Class(TServerClient)
ND : TNodeData;
Constructor Create (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass);
Procedure Execute; Override;
Destructor Destroy; Override;
End;
Implementation
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Begin
Result := TTelnetServer.Create(Owner, ND, CliSock);
End;
Constructor TTelnetServer.Create (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass);
Begin
Inherited Create(Owner, CliSock);
Self.ND := ND;
End;
{$IFDEF WIN32}
Procedure TTelnetServer.Execute;
Var
Cmd : String;
SI : TStartupInfo;
PI : TProcessInformation;
Num : LongInt;
NI : TNodeInfoRec;
PassHandle : LongInt;
Begin
If Not DuplicateHandle (
GetCurrentProcess,
Client.FSocketHandle,
GetCurrentProcess,
@PassHandle,
0,
TRUE,
DUPLICATE_SAME_ACCESS) Then Exit;
Num := ND.GetFreeNode;
Cmd := 'mystic.exe -n' + strI2S(Num) + ' -TID' + strI2S(PassHandle) + ' -IP' + Client.FPeerIP + ' -HOST' + Client.FPeerName + #0;
FillChar(NI, SizeOf(NI), 0);
NI.Num := Num;
NI.Busy := True;
NI.IP := Client.FPeerIP;
NI.User := 'Unknown';
NI.Action := 'Logging In';
ND.SetNodeInfo(Num, NI);
FillChar(SI, SizeOf(SI), 0);
FillChar(PI, SizeOf(PI), 0);
SI.dwFlags := STARTF_USESHOWWINDOW;
SI.wShowWindow := SW_SHOWMINNOACTIVE;
If CreateProcess(NIL, PChar(@Cmd[1]),
NIL, NIL, True, create_new_console + normal_priority_class, NIL, NIL, SI, PI) Then
WaitForSingleObject (PI.hProcess, INFINITE);
NI.Busy := False;
NI.IP := '';
NI.User := '';
NI.Action := '';
ND.SetNodeInfo(Num, NI);
End;
{$ENDIF}
{$IFDEF UNIX}
Procedure TTelnetServer.Execute;
Var
Cmd : String;
Num : LongInt;
NI : TNodeInfoRec;
PassHandle : LongInt;
Begin
PassHandle := Client.FSocketHandle;
Num := ND.GetFreeNode;
Cmd := './mystic -n' + strI2S(Num) + ' -TID' + strI2S(PassHandle) + ' -UID' + Client.FPeerIP;
FillChar(NI, SizeOf(NI), 0);
NI.Num := Num;
NI.Busy := True;
NI.IP := Client.FPeerIP;
NI.User := 'Unknown';
NI.Action := 'Logging In';
ND.SetNodeInfo(Num, NI);
fpSystem(Cmd);
NI.Busy := False;
NI.IP := '';
NI.User := '';
NI.Action := '';
ND.SetNodeInfo(Num, NI);
End;
{$ENDIF}
Destructor TTelnetServer.Destroy;
Begin
Inherited Destroy;
End;
End.

241
mystic/mis_common.pas Normal file
View File

@ -0,0 +1,241 @@
Unit MIS_Common;
{$I M_OPS.PAS}
Interface
{$I RECORDS.PAS}
Var
bbsConfig : RecConfig;
Function SearchForUser (UN: String; Var Rec: RecUser; Var RecPos: LongInt) : Boolean;
Function CheckAccess (User: RecUser; IgnoreGroup: Boolean; Str: String) : Boolean;
Function WildcardMatch (Wildcard, FName: String) : Boolean;
Function GetSecurityLevel (Level: Byte; SecLevel: RecSecurity) : Boolean;
Implementation
Uses
m_FileIO,
m_DateTime,
m_Strings;
Function SearchForUser (UN: String; Var Rec: RecUser; Var RecPos: LongInt) : Boolean;
Var
UserFile : TBufFile;
Begin
Result := False;
UN := strUpper(UN);
If UN = '' Then Exit;
UserFile := TBufFile.Create(4096);
If UserFile.Open(bbsConfig.DataPath + 'users.dat', fmOpen, fmRWDN, SizeOf(RecUser)) Then
While Not UserFile.EOF Do Begin
UserFile.Read(Rec);
If Rec.Flags AND UserDeleted <> 0 Then Continue;
If (UN = strUpper(Rec.RealName)) or (UN = strUpper(Rec.Handle)) Then Begin
RecPos := UserFile.FilePos;
Result := True;
Break;
End;
End;
UserFile.Free;
End;
Function CheckAccess (User: RecUser; IgnoreGroup: Boolean; Str: String) : Boolean;
Const
OpCmds = ['%', '^', '(', ')', '&', '!', '|'];
AcsCmds = ['A', 'D', 'E', 'F', 'G', 'H', 'M', 'N', 'O', 'S', 'T', 'U', 'W', 'Z'];
Var
Key : Char;
Data : String;
Check : Boolean;
Out : String;
First : Boolean;
Procedure CheckCommand;
Var
Res : Boolean;
Temp1 : LongInt;
Temp2 : LongInt;
Begin
Res := False;
Case Key of
'A' : Res := True;
'D' : Res := (Ord(Data[1]) - 64) in User.AF2;
'E' : Case Data[1] of
'1' : Res := True;
'0' : Res := True;
End;
'F' : Res := (Ord(Data[1]) - 64) in User.AF1;
'G' : If IgnoreGroup Then Begin
First := True;
Check := False;
Data := '';
Exit;
End Else
Res := User.LastMGroup = strS2I(Data);
'H' : Res := strS2I(Data) < strS2I(Copy(TimeDos2Str(CurDateDos, False), 1, 2));
'M' : Res := strS2I(Data) < strS2I(Copy(TimeDos2Str(CurDateDos, False), 4, 2));
'N' : Res := True;
'O' : Case Data[1] of
'A' : Res := True;
'I' : Res := True;
'K' : Res := True;
'P' : If (User.Calls > 0) And (User.Flags AND UserNoRatio = 0) Then Begin
//Temp1 := Round(Security.PCRatio / 100 * 100);
//Temp2 := Round(User.ThisUser.Posts / User.ThisUser.Calls * 100);
//Res := (Temp2 >= Temp1);
Res := True;
End Else
Res := True;
End;
'S' : Res := User.Security >= strS2I(Data);
'T' : Res := True;
'U' : Res := User.PermIdx = strS2I(Data);
'W' : Res := strS2I(Data) = m_DateTime.DayOfWeek;
'Z' : If IgnoreGroup Then Begin
Check := False;
First := True;
Data := '';
Exit;
End Else
Res := strS2I(Data) = User.LastFGroup;
End;
If Res Then Out := Out + '^' Else Out := Out + '%';
Check := False;
First := True;
Data := '';
End;
Var
A : Byte;
Paran1 : Byte;
Paran2 : Byte;
Ch1 : Char;
Ch2 : Char;
S1 : String;
S2 : String;
Begin
Data := '';
Out := '';
Check := False;
Str := strUpper(Str);
First := True;
For A := 1 to Length(Str) Do
If Str[A] in OpCmds Then Begin
If Check Then CheckCommand;
Out := Out + Str[A];
End Else
If (Str[A] in AcsCmds) and (First or Check) Then Begin
If Check Then CheckCommand;
Key := Str[A];
If First Then First := False;
End Else Begin
Data := Data + Str[A];
Check := True;
If A = Length(Str) Then CheckCommand;
End;
Out := '(' + Out + ')';
While Pos('&', Out) <> 0 Do Delete (Out, Pos('&', Out), 1);
While Pos('(', Out) <> 0 Do Begin
Paran2 := 1;
While ((Out[Paran2] <> ')') And (Paran2 <= Length(Out))) Do Begin
If (Out[Paran2] = '(') Then Paran1 := Paran2;
Inc (Paran2);
End;
S1 := Copy(Out, Paran1 + 1, (Paran2 - Paran1) - 1);
While Pos('!', S1) <> 0 Do Begin
A := Pos('!', S1) + 1;
If S1[A] = '^' Then S1[A] := '%' Else
If S1[A] = '%' Then S1[A] := '^';
Delete (S1, A - 1, 1);
End;
While Pos('|', S1) <> 0 Do Begin
A := Pos('|', S1) - 1;
Ch1 := S1[A];
Ch2 := S1[A + 2];
If (Ch1 in ['%', '^']) and (Ch2 in ['%', '^']) Then Begin
Delete (S1, A, 3);
If (Ch1 = '^') or (Ch2 = '^') Then
Insert ('^', S1, A)
Else
Insert ('%', S1, A)
End Else
Delete (S1, A + 1, 1);
End;
While Pos('%%', S1) <> 0 Do Delete (S1, Pos('%%', S1), 1);
While Pos('^^', S1) <> 0 Do Delete (S1, Pos('^^', S1), 1);
While Pos('%^', S1) <> 0 Do Delete (S1, Pos('%^', S1) + 1, 1);
While Pos('^%', S1) <> 0 Do Delete (S1, Pos('^%', S1), 1);
Delete (Out, Paran1, (Paran2 - Paran1) + 1);
Insert (S1, Out, Paran1);
End;
Result := Pos('%', Out) = 0;
End;
Function WildcardMatch (Wildcard, FName: String) : Boolean;
Begin
Result := False;
If FName = '' Then Exit;
Case Wildcard[1] of
'*' : Begin
If FName[1] = '.' Then Exit;
If Length(Wildcard) = 1 Then Result := True;
If (Length(Wildcard) > 1) and (Wildcard[2] = '.') and (Length(FName) > 0) Then
Result := WildCardMatch(Copy(Wildcard, 3, Length(Wildcard) - 2), Copy(FName, Pos('.', FName) + 1, Length(FName)-Pos('.', FName)));
End;
'?' : If Ord(Wildcard[0]) = 1 Then
Result := True
Else
Result := WildCardMatch(Copy(Wildcard, 2, Length(Wildcard) - 1), Copy(FName, 2, Length(FName) - 1));
Else
If FName[1] = Wildcard[1] Then
If Length(wildcard) > 1 Then
Result := WildCardMatch(Copy(Wildcard, 2, Length(Wildcard) - 1), Copy(FName, 2, Length(FName) - 1))
Else
Result := (Length(FName) = 1) And (Length(Wildcard) = 1);
End;
End;
Function GetSecurityLevel (Level: Byte; SecLevel: RecSecurity) : Boolean;
Var
SecLevelFile : File of RecSecurity;
Begin
Result := False;
Assign (SecLevelFile, bbsConfig.DataPath + 'security.dat');
If Not ioReset (SecLevelFile, SizeOf(SecLevel), fmRWDN) Then Exit;
ioSeek (SecLevelFile, Level - 1);
ioRead (SecLevelFile, SecLevel);
Close (SecLevelFile);
Result := True;
End;
End.

115
mystic/mis_nodedata.pas Normal file
View File

@ -0,0 +1,115 @@
{$I M_OPS.PAS}
Unit MIS_NodeData;
// annoying node data class used until we fuse MIS and Mystic together
Interface
Uses
MIS_Common;
Type
TNodeInfoRec = Record
Num : Byte;
Busy : Boolean;
User : String;
Action : String;
IP : String;
End;
TNodeData = Class
NodeInfo : Array[1..199] of TNodeInfoRec;
NodeTotal : Byte;
Critical : TRTLCriticalSection;
Constructor Create (Nodes: Byte);
Destructor Destroy; Override;
Function GetNodeTotal : LongInt;
Function GetNodeInfo (Num: Byte; Var NI: TNodeInfoRec): Boolean;
Procedure SetNodeInfo (Num: Byte; NI: TNodeInfoRec);
Function GetFreeNode : LongInt;
End;
Implementation
Uses
m_FileIO,
m_Strings;
Function TNodeData.GetFreeNode : LongInt;
Var
Count : LongInt;
Begin
EnterCriticalSection(Critical);
Result := -1;
For Count := 1 to NodeTotal Do
If Not NodeInfo[Count].Busy Then Begin
NodeInfo[Count].Busy := True;
Result := NodeInfo[Count].Num;
Break;
End;
LeaveCriticalSection(Critical);
End;
Function TNodeData.GetNodeInfo (Num: Byte; Var NI: TNodeInfoRec) : Boolean;
Begin
EnterCriticalSection(Critical);
Result := False;
FillChar(NI, SizeOf(NI), 0);
If Num <= NodeTotal Then Begin
NI := NodeInfo[Num];
Result := True;
End;
LeaveCriticalSection(Critical);
End;
Procedure TNodeData.SetNodeInfo (Num: Byte; NI: TNodeInfoRec);
Var
Count : LongInt;
Begin
EnterCriticalSection(Critical);
For Count := 1 to NodeTotal Do
If NodeInfo[Count].Num = Num Then
NodeInfo[Count] := NI;
LeaveCriticalSection(Critical);
End;
Function TNodeData.GetNodeTotal : LongInt;
Begin
EnterCriticalSection(Critical);
Result := NodeTotal;
LeaveCriticalSection(Critical);
End;
Constructor TNodeData.Create (Nodes: Byte);
Var
Count : SmallInt;
Begin
InitCriticalSection(Critical);
NodeTotal := Nodes;
For Count := 1 to NodeTotal Do
NodeInfo[Count].Num := Count;
End;
Destructor TNodeData.Destroy;
Begin
DoneCriticalSection(Critical);
Inherited Destroy;
End;
End.

262
mystic/mis_server.pas Normal file
View File

@ -0,0 +1,262 @@
{$I M_OPS.PAS}
Unit MIS_Server;
Interface
Uses
Classes,
m_Socket_Class,
MIS_Common,
MIS_NodeData;
Type
TServerManager = Class;
TServerClient = Class;
TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TSocketClass): TServerClient;
TServerManager = Class(TThread)
NodeInfo : TNodeData;
Server : TSocketClass;
ClientList : TList;
NewClientProc : TServerCreateProc;
Config : RecConfig;
ClientMax : LongInt;
ClientMaxIPs : LongInt;
ClientRefused : LongInt;
ClientBlocked : LongInt;
ClientTotal : LongInt;
ClientActive : LongInt;
Port : LongInt;
TextPath : String[80];
Constructor Create (Config: RecConfig; PortNum: Word; CliMax: Word; ND: TNodeData; CreateProc: TServerCreateProc);
Destructor Destroy; Override;
Procedure Execute; Override;
Function CheckIP (IP, Mask: String) : Boolean;
Function IsBlockedIP (Var Client: TSocketClass) : Boolean;
Function DuplicateIPs (Var Client: TSocketClass) : Byte;
End;
TServerClient = Class(TThread)
Client : TSocketClass;
Manager : TServerManager;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Destructor Destroy; Override;
End;
Implementation
Uses
m_Strings,
m_DateTime;
Constructor TServerManager.Create (Config: RecConfig; PortNum: Word; CliMax: Word; ND: TNodeData; CreateProc: TServerCreateProc);
Var
Count : Byte;
Begin
Inherited Create(False);
Port := PortNum;
ClientMax := CliMax;
ClientRefused := 0;
ClientBlocked := 0;
ClientTotal := 0;
ClientActive := 0;
ClientMaxIPs := 1;
NewClientProc := CreateProc;
Server := TSocketClass.Create;
ClientList := TList.Create;
TextPath := Config.DataPath;
NodeInfo := ND;
Config := Config;
For Count := 1 to ClientMax Do
ClientList.Add(NIL);
FreeOnTerminate := False;
End;
Function TServerManager.CheckIP (IP, Mask: String) : Boolean;
Var
A : Byte;
Count : Byte;
Str : String;
Str2 : String;
EndIt : Byte;
Begin
Result := True;
For Count := 1 to 4 Do Begin
If Count < 4 Then Begin
Str := Copy(IP, 1, Pos('.', IP) - 1);
Str2 := Copy(Mask, 1, Pos('.', Mask) - 1);
Delete (IP, 1, Pos('.', IP));
Delete (Mask, 1, Pos('.', Mask));
End Else Begin
Str := Copy(IP, 1, Length(IP));
Str2 := Copy(Mask, 1, Length(Mask));
End;
For A := 1 to Length(Str) Do
If Str2[A] = '*' Then
Break
Else
If Str[A] <> Str2[A] Then Begin
Result := False;
Break;
End;
If Not Result Then Break;
End;
End;
Function TServerManager.IsBlockedIP (Var Client: TSocketClass) : Boolean;
Var
TF : Text;
Str : String;
Begin
Result := False;
FileMode := 66;
Assign (TF, TextPath + 'badip.txt');
Reset (TF);
If IoResult = 0 Then Begin
While Not Eof(TF) Do Begin
ReadLn (TF, Str);
If CheckIP (Client.PeerIP, Str) Then Begin
Result := True;
Break;
End;
End;
Close (TF);
End;
End;
Function TServerManager.DuplicateIPs (Var Client: TSocketClass) : Byte;
Var
Count : Byte;
Begin
Result := 0;
For Count := 0 to ClientMax - 1 Do
If ClientList[Count] <> NIL Then // use Assigned?
If Client.PeerIP = TSocketClass(ClientList[Count]).PeerIP Then
Inc(Result);
End;
Procedure TServerManager.Execute;
Var
NewClient : TSocketClass;
Begin
Repeat Until Server <> NIL; // Synchronize with server class
Repeat Until Server.SocketStatus <> NIL; // Syncronize with status class
Server.WaitInit(Port);
If Terminated Then Exit;
If ClientMax = 0 Then
Server.Status('WARNING: At least one server is configured with 0 max clients.');
Server.Status('Opening server socket on port ' + strI2S(Port));
Repeat
NewClient := Server.WaitConnection;
If NewClient = NIL Then Break; // time to shutdown the server...
If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin
Inc (ClientRefused);
Server.Status ('BUSY: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'busy.txt') Then NewClient.WriteLine('BUSY');
NewClient.Free;
End Else
If IsBlockedIP(NewClient) Then Begin
Inc (ClientBlocked);
Server.Status('BLOCK: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED');
NewClient.Free;
End Else
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin
Inc (ClientRefused);
Server.Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user');
NewClient.Free;
End Else Begin
Inc (ClientTotal);
Inc (ClientActive);
Server.Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
NewClientProc(Self, Config, NodeInfo, NewClient);
End;
Until Terminated;
Server.Status ('Shutting down server...');
End;
Destructor TServerManager.Destroy;
Var
Count : LongInt;
Angry : Byte;
Begin
Angry := 20; // about 5 seconds before we get mad at thread...
ClientList.Pack;
While (ClientList.Count > 0) and (Angry > 0) Do Begin
For Count := 0 To ClientList.Count - 1 Do
If ClientList[Count] <> NIL Then Begin
TServerClient(ClientList[Count]).Client.Disconnect;
TServerClient(ClientList[Count]).Terminate;
End;
WaitMS(250);
Dec (Angry);
ClientList.Pack;
End;
ClientList.Free;
Server.Free;
Inherited Destroy;
End;
Constructor TServerClient.Create (Owner: TServerManager; CliSock: TSocketClass);
Var
Count : Byte;
Begin
Manager := Owner;
Client := CliSock;
For Count := 0 to Manager.ClientMax - 1 Do
If Manager.ClientList[Count] = NIL Then Begin
Manager.ClientList[Count] := Self;
Break;
End;
Inherited Create(False);
FreeOnTerminate := True;
End;
Destructor TServerClient.Destroy;
Begin
Client.Free;
Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL;
If Manager.Server <> NIL Then
Manager.Server.StatusUpdated := True;
Dec (Manager.ClientActive);
Inherited Destroy;
End;
End.

305
mystic/mkcrap.pas Normal file
View File

@ -0,0 +1,305 @@
{$I M_OPS.PAS}
Unit mkcrap;
// this is various functions and procedures used by JAM/Squish...
// these should be removed and/or incorporated into mystic's code base as
// soon as possible.
// CHANGE JAM TEMP BUFFER.. ADD SETBUFFERFILE METHOD TO MSGBASE OBJECTS!!!!
interface
uses
dos;
Function ToUnixDate(FDate: LongInt): LongInt;
Function DTToUnixDate(DT: DateTime): LongInt;
Procedure UnixToDT(SecsPast: LongInt; Var Dt: DateTime);
Function SaveFile(FN: String; Var Rec; FS: Word): Word;
Procedure Str2Az(Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
Function FormattedDate(DT: DateTime; Mask: String): String;
Function LoadFile(FN: String; Var Rec; FS: Word): Word;
Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Function GetFileSize (FN : String) : LongInt;
Function ExtendFile(FN: String; ToSize: LongInt): Word;
Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
implementation
Uses
m_FileIO,
m_DateTime,
m_Strings;
Const
DATEC1970 = 2440588;
// DATED0 = 1461;
// DATED1 = 146097;
// DATED2 = 1721119;
Function DTToUnixDate(DT: DateTime): LongInt;
Var
SecsPast, DaysPast: LongInt;
Begin
DateG2J (DT.Year, DT.Month, DT.Day, DaysPast);
DaysPast := DaysPast - DATEc1970;
SecsPast := DaysPast * 86400;
SecsPast := SecsPast + (LongInt(DT.Hour) * 3600) + (DT.Min * 60) + (DT.Sec);
DTToUnixDate := SecsPast;
End;
Function ToUnixDate(FDate: LongInt): LongInt;
Var
DT: DateTime;
Begin
UnpackTime(Fdate, DT);
ToUnixDate := DTToUnixDate(Dt);
End;
Procedure UnixToDT(SecsPast: LongInt; Var Dt: DateTime);
Var
DateNum : LongInt; //might be able to remove this
Begin
Datenum := (SecsPast Div 86400) + DATEc1970;
FillChar(DT, SizeOf(DT), 0);
DateJ2G(DateNum, SmallInt(DT.Year), SmallInt(DT.Month), SmallInt(DT.Day));
SecsPast := SecsPast Mod 86400;
DT.Hour := SecsPast Div 3600;
SecsPast := SecsPast Mod 3600;
DT.Min := SecsPast Div 60;
DT.Sec := SecsPast Mod 60;
End;
Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Var
F: File;
Error: Word;
temp:longint;
Begin
Error := 0;
assign (f, fn);
FileMode := fmReadWrite + fmDenyNone;
If FileExist(FN) Then Begin
reset(f,1);
if ioresult <> 0 then error := ioresult;
End Else Begin
ReWrite(F,1);
Error := IoResult;
End;
If Error = 0 Then Begin
Seek(F, FPos);
Error := IoResult;
End;
If Error = 0 Then
If FS > 0 Then Begin
If Not ioBlockWrite(F, Rec, FS, Temp) Then Error := ioCode;
End;
If Error = 0 Then Begin
Close(F);
Error := IoResult;
End;
SaveFilePos := Error;
End;
Function SaveFile(FN: String; Var Rec; FS: Word): Word;
Begin
SaveFile := SaveFilePos(FN, Rec, FS, 0);
End;
Procedure Str2Az(Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
Begin
If Length(Str) >= MaxLen Then
Begin
Str[MaxLen] := #0;
Move(Str[1], AZStr, MaxLen);
End
Else
Begin
Str[Length(Str) + 1] := #0;
Move(Str[1], AZStr, Length(Str) + 1);
End;
End;
Function MonthStr(MonthNo: Word): String;
Begin
Case MonthNo of
01: MonthStr := 'Jan';
02: MonthStr := 'Feb';
03: MonthStr := 'Mar';
04: MonthStr := 'Apr';
05: MonthStr := 'May';
06: MonthStr := 'Jun';
07: MonthStr := 'Jul';
08: MonthStr := 'Aug';
09: MonthStr := 'Sep';
10: MonthStr := 'Oct';
11: MonthStr := 'Nov';
12: MonthStr := 'Dec';
Else
MonthStr := '???';
End;
End;
Function FormattedDate(DT: DateTime; Mask: String): String;
Var
DStr : String[2];
MStr : String[2];
MNStr : String[3];
YStr : String[4];
HourStr : String[2];
MinStr : String[2];
SecStr : String[2];
TmpStr : String;
CurrPos : Word;
i : Word;
Begin
TmpStr := Mask;
Mask := strUpper(Mask);
DStr := Copy(strPadL(strI2S(Dt.Day), 2, '0'), 1, 2);
MStr := Copy(strPadL(strI2S(Dt.Month), 2, '0'), 1, 2);
YStr := Copy(strPadL(strI2S(Dt.Year), 4, '0'), 1, 4);
HourStr := Copy(strPadL(strI2S(Dt.Hour), 2, ' '), 1, 2);
MinStr := Copy(strPadL(strI2S(Dt.Min), 2, '0'), 1, 2);
SecStr := Copy(strPadL(strI2S(Dt.Sec), 2, '0'), 1, 2);
MNStr := MonthStr(Dt.Month);
If (Pos('YYYY', Mask) = 0) Then YStr := Copy(YStr,3,2);
CurrPos := Pos('DD', Mask);
If CurrPos > 0 Then
For i := 1 to Length(DStr) Do
TmpStr[CurrPos + i - 1] := DStr[i];
CurrPos := Pos('YY', Mask);
If CurrPos > 0 Then
For i := 1 to Length(YStr) Do
TmpStr[CurrPos + i - 1] := YStr[i];
CurrPos := Pos('MM', Mask);
If CurrPos > 0 Then
For i := 1 to Length(MStr) Do
TmpStr[CurrPos + i - 1] := MStr[i];
CurrPos := Pos('HH', Mask);
If CurrPos > 0 Then
For i := 1 to Length(HourStr) Do
TmpStr[CurrPos + i - 1] := HourStr[i];
CurrPos := Pos('SS', Mask);
If CurrPos > 0 Then
For i := 1 to Length(SecStr) Do
TmpStr[CurrPos + i - 1] := SecStr[i];
CurrPos := Pos('II', Mask);
If CurrPos > 0 Then
For i := 1 to Length(MinStr) Do
TmpStr[CurrPos + i - 1] := MinStr[i];
CurrPos := Pos('NNN', Mask);
If CurrPos > 0 Then
For i := 1 to Length(MNStr) Do
TmpStr[CurrPos + i - 1] := MNStr[i];
FormattedDate := TmpStr;
End;
Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
Var
F: File;
Error: Word;
NumRead: LongInt;
Begin
Error := 0;
If Not FileExist(FN) Then Error := 8888;
If Error = 0 Then assign (f, fn);
FileMode := fmReadWrite + fmDenyNone;
reset (f, 1);
error := ioresult;
If Error = 0 Then Begin
Seek(F, FPos);
Error := IoResult;
End;
If Error = 0 Then
If Not ioBlockRead(F, Rec, FS, NumRead) Then
Error := ioCode;
If Error = 0 Then
Begin
Close(F);
Error := IoResult;
End;
LoadFilePos := Error;
End;
Function LoadFile(FN: String; Var Rec; FS: Word): Word;
Begin
LoadFile := LoadFilePos(FN, Rec, FS, 0);
End;
Function GetFileSize (FN : String) : LongInt;
Var
SR : SearchRec;
Begin
FindFirst (FN, AnyFile, SR);
If DosError = 0 Then
GetFileSize := SR.Size
Else
GetFileSize := -1;
End;
Function ExtendFile(FN: String; ToSize: LongInt): Word;
{Pads file with nulls to specified size}
Type
FillType = Array[1..8000] of Byte;
Var
F: File;
Error: Word;
FillRec: ^FillType;
temp:longint;
Begin
Error := 0;
New(FillRec);
If FillRec = Nil Then
Error := 10;
If Error = 0 Then
Begin
FillChar(FillRec^, SizeOf(FillRec^), 0);
Assign(F, FN);
FileMode := fmReadWrite + fmDenyNone;
If FileExist(FN) Then Begin
reset(f,1);
if ioresult <> 0 then error := ioresult;
End
Else
Begin
ReWrite(F,1);
Error := IoResult;
End;
End;
If Error = 0 Then
Begin
Seek(F, FileSize(F));
Error := IoResult;
End;
If Error = 0 Then
Begin
While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
Begin
If Not ioBlockWrite(F, FillRec^, SizeOf(FillRec^), Temp) Then
Error := ioCode;
End;
End;
If ((Error = 0) and (FileSize(F) < ToSize)) Then Begin
If Not ioBlockWrite(F, FillRec^, ToSize - FileSize(F), temp) Then
Error := ioCode;
End;
If Error = 0 Then Begin
Close(F);
Error := IoResult;
End;
Dispose(FillRec);
ExtendFile := Error;
End;
End.

365
mystic/mpl_common.pas Normal file
View File

@ -0,0 +1,365 @@
Function cGetVarChar (T: TIdentTypes) : Char;
Begin
Case T of
iString : Result := 's';
iChar : Result := 'c';
iByte : Result := 'b';
iShort : Result := 'h';
iWord : Result := 'w';
iInteger : Result := 'i';
iLongInt : Result := 'l';
iReal : Result := 'r';
iBool : Result := 'o';
iFile : Result := 'f';
iRecord : Result := 'x';
Else
Result := ' ';
End;
End;
Function cVarType (C: Char) : TIdentTypes;
begin
case UpCase(c) of
'S' : cVarType := iString;
'C' : cVarType := iChar;
'B' : cVarType := iByte;
'H' : cVarType := iShort;
'W' : cVarType := iWord;
'I' : cVarType := iInteger;
'L' : cVarType := iLongInt;
'R' : cVarType := iReal;
'O' : cVarType := iBool;
'F' : cVarType := iFile;
'X' : cVarType := iRecord;
else
cVarType := iNone;
end;
end;
Function xVarSize (T: TIdentTypes) : Word;
Begin
Case T of
iRecord,
iNone : xVarSize := 0;
iString : xVarSize := 256;
iChar : xVarSize := 1;
iByte : xVarSize := 1;
iShort : xVarSize := 1;
iWord : xVarSize := 2;
iInteger : xVarSize := 2;
iLongInt : xVarSize := 4;
iReal : xVarSize := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF};
iBool : xVarSize := 1;
iFile : xVarSize := SizeOf(File); // was 128;
End;
End;
Procedure InitProcedures (O: Pointer; S: Pointer; Var CV: VarDataRec; Var X: Word; Var IW: Word; Mode: Byte);
Procedure AddProc ({$IFDEF MPLPARSER} I: String; {$ENDIF} P: String; T: TIdentTypes);
Begin
Inc(X);
New(CV[X]);
With CV[X]^ Do Begin
VarID := IW;
Inc(IW);
vType := T;
Move(P[1], Params, Ord(P[0]));
NumParams := Ord(p[0]);
{$IFNDEF MPLPARSER}
VarSize := 0;
DataSize := 0;
Data := NIL;
ProcPos := 0;
Kill := True;
FillChar (pID, SizeOf(pID), 0);
{$ELSE}
Ident := I;
InProc := False;
Proc := True;
{$ENDIF}
ArrPos := 0;
End;
End;
Procedure AddStr ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes; SI: Word);
Begin
Inc(X);
New(CV[X]);
With cV[x]^ Do Begin
VarID := IW;
Inc(IW);
vType := T;
NumParams := 0;
{$IFNDEF MPLPARSER}
VarSize := SI + 1;
DataSize := VarSize;
GetMem (Data, DataSize);
FillChar (Data^, DataSize, 0);
FillChar (pID, SizeOf(pID), 0); //cant we just assign it to 0 here?
ProcPos := 0;
Kill := True;
{$ELSE}
Ident := I;
InProc := False;
Proc := False;
{$ENDIF}
ArrPos := 0;
End;
End;
Procedure AddVar ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes);
Begin
AddStr ({$IFDEF MPLPARSER} I, {$ENDIF} T, xVarSize(T) - 1);
End;
Procedure AddPointer ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes; SI: Word; PD: Pointer);
Begin
Inc(x);
New(cV[x]);
With cV[x]^ Do Begin
VarID := IW;
Inc(IW);
vType := t;
NumParams := 0;
{$IFNDEF MPLPARSER}
If T = iString Then VarSize := SI + 1 Else VarSize := SI;
DataSize := VarSize;
Data := PD;
FillChar (pID, SizeOf(pID), 0);
ProcPos := 0;
Kill := False;
{$ELSE}
Ident := I;
InProc := False;
Proc := False;
{$ENDIF}
ArrPos := 0;
End;
End;
Begin
Case Mode of
0 : Begin
IW := 0;
AddProc ({$IFDEF MPLPARSER} 'write', {$ENDIF} 's', iNone); // 0
AddProc ({$IFDEF MPLPARSER} 'writeln', {$ENDIF} 's', iNone); // 1
AddProc ({$IFDEF MPLPARSER} 'clrscr', {$ENDIF} '', iNone); // 2
AddProc ({$IFDEF MPLPARSER} 'clreol', {$ENDIF} '', iNone); // 3
AddProc ({$IFDEF MPLPARSER} 'gotoxy', {$ENDIF} 'bb', iNone); // 4
AddProc ({$IFDEF MPLPARSER} 'wherex', {$ENDIF} '', iByte); // 5
AddProc ({$IFDEF MPLPARSER} 'wherey', {$ENDIF} '', iByte); // 6
AddProc ({$IFDEF MPLPARSER} 'readkey', {$ENDIF} '', iString); // 7
AddProc ({$IFDEF MPLPARSER} 'delay', {$ENDIF} 'l', iNone); // 8
AddProc ({$IFDEF MPLPARSER} 'random', {$ENDIF} 'l', iLongInt); // 9
AddProc ({$IFDEF MPLPARSER} 'chr', {$ENDIF} 'b', iChar); // 10
AddProc ({$IFDEF MPLPARSER} 'ord', {$ENDIF} 's', iByte); // 11
AddProc ({$IFDEF MPLPARSER} 'copy', {$ENDIF} 'sll', iString); // 12
AddProc ({$IFDEF MPLPARSER} 'delete', {$ENDIF} 'Sll', iNone); // 13
AddProc ({$IFDEF MPLPARSER} 'insert', {$ENDIF} 'sSl', iNone); // 14
AddProc ({$IFDEF MPLPARSER} 'length', {$ENDIF} 's', iLongInt); // 15
AddProc ({$IFDEF MPLPARSER} 'odd', {$ENDIF} 'l', iBool); // 16
AddProc ({$IFDEF MPLPARSER} 'pos', {$ENDIF} 'ss', iLongInt); // 17
AddProc ({$IFDEF MPLPARSER} 'keypressed', {$ENDIF} '', iBool); // 18
AddProc ({$IFDEF MPLPARSER} 'padrt', {$ENDIF} 'sbs', iString); // 19
AddProc ({$IFDEF MPLPARSER} 'padlt', {$ENDIF} 'sbs', iString); // 20
AddProc ({$IFDEF MPLPARSER} 'padct', {$ENDIF} 'sbs', iString); // 21
AddProc ({$IFDEF MPLPARSER} 'upper', {$ENDIF} 's', iString); // 22
AddProc ({$IFDEF MPLPARSER} 'lower', {$ENDIF} 's', iString); // 23
AddProc ({$IFDEF MPLPARSER} 'strrep', {$ENDIF} 'sb', iString); // 24
AddProc ({$IFDEF MPLPARSER} 'strcomma', {$ENDIF} 'l', iString); // 25
AddProc ({$IFDEF MPLPARSER} 'int2str', {$ENDIF} 'l', iString); // 26
AddProc ({$IFDEF MPLPARSER} 'str2int', {$ENDIF} 's', iLongInt); // 27
AddProc ({$IFDEF MPLPARSER} 'int2hex', {$ENDIF} 'l', iString); // 28
AddProc ({$IFDEF MPLPARSER} 'wordget', {$ENDIF} 'bss', iString); // 29
AddProc ({$IFDEF MPLPARSER} 'wordpos', {$ENDIF} 'bss', iByte); // 30
AddProc ({$IFDEF MPLPARSER} 'wordcount', {$ENDIF} 'ss', iByte); // 31
AddProc ({$IFDEF MPLPARSER} 'stripl', {$ENDIF} 'ss', iString); // 32
AddProc ({$IFDEF MPLPARSER} 'stripr', {$ENDIF} 'ss', iString); // 33
AddProc ({$IFDEF MPLPARSER} 'stripb', {$ENDIF} 'ss', iString); // 34
AddProc ({$IFDEF MPLPARSER} 'striplow', {$ENDIF} 's', iString); // 35
AddProc ({$IFDEF MPLPARSER} 'stripmci', {$ENDIF} 's', iString); // 36
AddProc ({$IFDEF MPLPARSER} 'mcilength', {$ENDIF} 's', iByte); // 37
AddProc ({$IFDEF MPLPARSER} 'initials', {$ENDIF} 's', iString); // 38
AddProc ({$IFDEF MPLPARSER} 'strwrap', {$ENDIF} 'SSb', iByte); // 39
AddProc ({$IFDEF MPLPARSER} 'replace', {$ENDIF} 'sss', iString); // 40
AddProc ({$IFDEF MPLPARSER} 'readenv', {$ENDIF} 's', iString); // 41
AddProc ({$IFDEF MPLPARSER} 'fileexist', {$ENDIF} 's', iBool); // 42
AddProc ({$IFDEF MPLPARSER} 'fileerase', {$ENDIF} 's', iNone); // 43
AddProc ({$IFDEF MPLPARSER} 'direxist', {$ENDIF} 's', iBool); // 44
AddProc ({$IFDEF MPLPARSER} 'timermin', {$ENDIF} '', iLongInt); // 45
AddProc ({$IFDEF MPLPARSER} 'timer', {$ENDIF} '', iLongInt); // 46
AddProc ({$IFDEF MPLPARSER} 'datetime', {$ENDIF} '', iLongInt); // 47
AddProc ({$IFDEF MPLPARSER} 'datejulian', {$ENDIF} '', iLongInt); // 48
AddProc ({$IFDEF MPLPARSER} 'datestr', {$ENDIF} 'lb', iString); // 49
AddProc ({$IFDEF MPLPARSER} 'datestrjulian', {$ENDIF} 'lb', iString); // 50
AddProc ({$IFDEF MPLPARSER} 'date2dos', {$ENDIF} 's', iLongInt); // 51
AddProc ({$IFDEF MPLPARSER} 'date2julian', {$ENDIF} 's', iLongInt); // 52
AddProc ({$IFDEF MPLPARSER} 'dateg2j', {$ENDIF} 'lllL', iNone); // 53
AddProc ({$IFDEF MPLPARSER} 'datej2g', {$ENDIF} 'liii', iNone); // 54
AddProc ({$IFDEF MPLPARSER} 'datevalid', {$ENDIF} 's', iString); // 55
AddProc ({$IFDEF MPLPARSER} 'timestr', {$ENDIF} 'lo', iString); // 56
AddProc ({$IFDEF MPLPARSER} 'dayofweek', {$ENDIF} '', iByte); // 57
AddProc ({$IFDEF MPLPARSER} 'daysago', {$ENDIF} 'l', iLongInt); // 58
AddProc ({$IFDEF MPLPARSER} 'justfile', {$ENDIF} 's', iString); // 59
AddProc ({$IFDEF MPLPARSER} 'justfilename', {$ENDIF} 's', iString); // 60
AddProc ({$IFDEF MPLPARSER} 'justfileext', {$ENDIF} 's', iString); // 61
AddProc ({$IFDEF MPLPARSER} 'fassign', {$ENDIF} 'Fsl', iNone); // 62
AddProc ({$IFDEF MPLPARSER} 'freset', {$ENDIF} 'F', iNone); // 63
AddProc ({$IFDEF MPLPARSER} 'frewrite', {$ENDIF} 'F', iNone); // 64
AddProc ({$IFDEF MPLPARSER} 'fclose', {$ENDIF} 'F', iNone); // 65
AddProc ({$IFDEF MPLPARSER} 'fseek', {$ENDIF} 'Fl', iNone); // 66
AddProc ({$IFDEF MPLPARSER} 'feof', {$ENDIF} 'F', iBool); // 67
AddProc ({$IFDEF MPLPARSER} 'fsize', {$ENDIF} 'F', iLongInt); // 68
AddProc ({$IFDEF MPLPARSER} 'fpos', {$ENDIF} 'F', iLongInt); // 69
AddProc ({$IFDEF MPLPARSER} 'fread', {$ENDIF} 'F*w', iNone); // 70
AddProc ({$IFDEF MPLPARSER} 'fwrite', {$ENDIF} 'F*w', iNone); // 71
AddProc ({$IFDEF MPLPARSER} 'freadln', {$ENDIF} 'FS', iNone); // 72
AddProc ({$IFDEF MPLPARSER} 'fwriteln', {$ENDIF} 'Fs', iNone); // 73
AddProc ({$IFDEF MPLPARSER} 'pathchar', {$ENDIF} '', iChar); // 74
AddProc ({$IFDEF MPLPARSER} 'bitcheck', {$ENDIF} 'b*', iBool); // 75
AddProc ({$IFDEF MPLPARSER} 'bittoggle', {$ENDIF} 'b*', iNone); // 76
AddProc ({$IFDEF MPLPARSER} 'bitset', {$ENDIF} 'b*o', iNone); // 77
AddProc ({$IFDEF MPLPARSER} 'findfirst', {$ENDIF} 'sw', iNone); // 78
AddProc ({$IFDEF MPLPARSER} 'findnext', {$ENDIF} '', iNone); // 79
AddProc ({$IFDEF MPLPARSER} 'findclose', {$ENDIF} '', iNone); // 80
AddProc ({$IFDEF MPLPARSER} 'justpath', {$ENDIF} 's', iString); // 81
AddProc ({$IFDEF MPLPARSER} 'randomize', {$ENDIF} '', iNone); // 82
AddProc ({$IFDEF MPLPARSER} 'paramcount', {$ENDIF} '', iByte); // 83
AddProc ({$IFDEF MPLPARSER} 'paramstr', {$ENDIF} 'b', iString); // 84
AddProc ({$IFDEF MPLPARSER} 'textattr', {$ENDIF} '', iByte); // 85
AddProc ({$IFDEF MPLPARSER} 'textcolor', {$ENDIF} 'b', iNone); // 86
AddProc ({$IFDEF MPLPARSER} 'addslash', {$ENDIF} 's', iString); // 87
AddProc ({$IFDEF MPLPARSER} 'strippipe', {$ENDIF} 's', iString); // 88
IW := 500; // BEGIN BBS-SPECIFIC STUFF
AddProc ({$IFDEF MPLPARSER} 'input', {$ENDIF} 'bbbs', iString); // 500
AddProc ({$IFDEF MPLPARSER} 'getuser', {$ENDIF} 'l', iBool); // 501
AddProc ({$IFDEF MPLPARSER} 'onekey', {$ENDIF} 'so', iChar); // 502
AddProc ({$IFDEF MPLPARSER} 'getthisuser', {$ENDIF} '', iNone); // 503
AddProc ({$IFDEF MPLPARSER} 'inputyn', {$ENDIF} 's', iBool); // 504
AddProc ({$IFDEF MPLPARSER} 'inputny', {$ENDIF} 's', iBool); // 505
AddProc ({$IFDEF MPLPARSER} 'dispfile', {$ENDIF} 's', iBool); // 506
AddProc ({$IFDEF MPLPARSER} 'filecopy', {$ENDIF} 'ss', iBool); // 507
AddProc ({$IFDEF MPLPARSER} 'menucmd', {$ENDIF} 'ss', iNone); // 508
AddProc ({$IFDEF MPLPARSER} 'stuffkey', {$ENDIF} 's', iNone); // 509
AddProc ({$IFDEF MPLPARSER} 'acs', {$ENDIF} 's', iBool); // 510
AddProc ({$IFDEF MPLPARSER} 'upuser', {$ENDIF} 'i', iNone); // 511
AddProc ({$IFDEF MPLPARSER} 'setusertime', {$ENDIF} 'i', iNone); // 512
AddProc ({$IFDEF MPLPARSER} 'hangup', {$ENDIF} '', iNone); // 513
AddProc ({$IFDEF MPLPARSER} 'getmbase', {$ENDIF} 'l', iBool); // 514
AddProc ({$IFDEF MPLPARSER} 'getprompt', {$ENDIF} 'l', iString); // 515
AddProc ({$IFDEF MPLPARSER} 'getmgroup', {$ENDIF} 'l', iBool); // 516
AddProc ({$IFDEF MPLPARSER} 'purgeinput', {$ENDIF} '', iNone); // 517
AddProc ({$IFDEF MPLPARSER} 'getfbase', {$ENDIF} 'l', iBool); // 518
AddProc ({$IFDEF MPLPARSER} 'getfgroup', {$ENDIF} 'l', iBool); // 519
AddProc ({$IFDEF MPLPARSER} 'sysoplog', {$ENDIF} 's', iNone); // 520
AddProc ({$IFDEF MPLPARSER} 'movex', {$ENDIF} 'b', iNone); // 521
AddProc ({$IFDEF MPLPARSER} 'movey', {$ENDIF} 'b', iNone); // 522
AddProc ({$IFDEF MPLPARSER} 'writepipe', {$ENDIF} 's', iNone); // 523
AddProc ({$IFDEF MPLPARSER} 'writepipeln', {$ENDIF} 's', iNone); // 524
AddProc ({$IFDEF MPLPARSER} 'writeraw', {$ENDIF} 's', iNone); // 525
AddProc ({$IFDEF MPLPARSER} 'writerawln', {$ENDIF} 's', iNone); // 526
AddProc ({$IFDEF MPLPARSER} 'mci2str', {$ENDIF} 's', iString); // 527
AddProc ({$IFDEF MPLPARSER} 'getusertime', {$ENDIF} '', iInteger); // 528
AddProc ({$IFDEF MPLPARSER} 'getscreeninfo', {$ENDIF} 'bBBB', iNone); // 529
AddProc ({$IFDEF MPLPARSER} 'setprompt', {$ENDIF} 'bs', iNone); // 530
AddProc ({$IFDEF MPLPARSER} 'moreprompt', {$ENDIF} '', iChar); // 531
AddProc ({$IFDEF MPLPARSER} 'pause', {$ENDIF} '', iNone); // 532
AddProc ({$IFDEF MPLPARSER} 'setpromptinfo', {$ENDIF} 'bs', iNone); // 533
AddProc ({$IFDEF MPLPARSER} 'bufflush', {$ENDIF} '', iNone); // 534
AddProc ({$IFDEF MPLPARSER} 'strmci', {$ENDIF} 's', iString); // 535
AddProc ({$IFDEF MPLPARSER} 'getcharxy', {$ENDIF} 'bb', iChar); // 536
AddProc ({$IFDEF MPLPARSER} 'getattrxy', {$ENDIF} 'bb', iByte); // 537
{ END OF PROCEDURE DEFINITIONS }
AddPointer ({$IFDEF MPLPARSER} 'ioresult', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @TInterpEngine(S).IoError {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'doserror', {$ENDIF} iInteger, 2, {$IFNDEF MPLPARSER} @DosError {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'progparams', {$ENDIF} iString, 256, {$IFNDEF MPLPARSER} @TInterpEngine(S).ParamsStr {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'progname', {$ENDIF} iString, 256, {$IFNDEF MPLPARSER} @TInterpEngine(S).MPEName {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'graphics', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @Session.io.Graphics {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'isarrow', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.io.IsArrow {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'nodenum', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @Session.NodeNum {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'local', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.LocalMode {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'allowarrow', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.io.AllowArrow {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'ignoregroups', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.User.IgnoreGroup {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'pausepos', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @Session.io.PausePtr {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'allowmci', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.io.PausePtr {$ELSE} NIL {$ENDIF});
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarDir := X + 1; {$ENDIF}
AddPointer ({$IFDEF MPLPARSER} 'dirname', {$ENDIF} iString, 256, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Name {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirsize', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Size {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirtime', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Time {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirattr', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Attr {$ELSE} NIL {$ENDIF});
End;
1 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarUser := X + 1; {$ENDIF}
AddVar ({$IFDEF MPLPARSER} 'userpermidx', {$ENDIF} iLongInt);
AddStr ({$IFDEF MPLPARSER} 'username', {$ENDIF} iString, 30);
AddStr ({$IFDEF MPLPARSER} 'useralias', {$ENDIF} iString, 30);
AddStr ({$IFDEF MPLPARSER} 'useraddress', {$ENDIF} iString, 30);
AddVar ({$IFDEF MPLPARSER} 'usersec', {$ENDIF} iInteger);
AddVar ({$IFDEF MPLPARSER} 'usersex', {$ENDIF} iChar);
AddVar ({$IFDEF MPLPARSER} 'userfirston', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'userlaston', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'userdatetype', {$ENDIF} iByte);
AddVar ({$IFDEF MPLPARSER} 'usercalls', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'userpassword', {$ENDIF} iString);
AddVar ({$IFDEF MPLPARSER} 'userflags', {$ENDIF} iByte);
End;
2 : Begin
AddPointer ({$IFDEF MPLPARSER} 'cfgsyspath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.SystemPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgdatapath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.DataPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfglogspath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.LogsPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgmsgspath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.MsgsPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgattpath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.AttachPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgqwkpath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.QwkPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgmenupath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Session.Lang.MenuPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgtextpath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Session.Lang.TextPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgmpepath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.ScriptPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgtemppath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Session.TempPath {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgtimeout', {$ENDIF} iWord, 4, {$IFNDEF MPLPARSER} @Config.Inactivity {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfgseeinvis', {$ENDIF} iString, 20, {$IFNDEF MPLPARSER} @Config.AcsSeeInvis {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'cfginettnmax', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @Config.INetTNMax {$ELSE} NIL {$ENDIF});
End;
3 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarMBase := X + 1; {$ENDIF}
AddVar ({$IFDEF MPLPARSER} 'mbaseindex', {$ENDIF} iInteger);
AddStr ({$IFDEF MPLPARSER} 'mbasename', {$ENDIF} iString, 40);
AddStr ({$IFDEF MPLPARSER} 'mbaseacs', {$ENDIF} iString, 20);
AddStr ({$IFDEF MPLPARSER} 'mbaseracs', {$ENDIF} iString, 20);
AddStr ({$IFDEF MPLPARSER} 'mbasepacs', {$ENDIF} iString, 20);
AddStr ({$IFDEF MPLPARSER} 'mbasesacs', {$ENDIF} iString, 20);
End;
4 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarMGroup := X + 1; {$ENDIF}
AddStr ({$IFDEF MPLPARSER} 'mgroupname', {$ENDIF} iString, 30);
AddStr ({$IFDEF MPLPARSER} 'mgroupacs', {$ENDIF} iString, 30);
AddVar ({$IFDEF MPLPARSER} 'mgrouphidden', {$ENDIF} iBool);
End;
5 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarFBase := X + 1; {$ENDIF}
AddStr ({$IFDEF MPLPARSER} 'fbasename', {$ENDIF} iString, 40);
AddStr ({$IFDEF MPLPARSER} 'fbaseacs', {$ENDIF} iString, 30);
End;
6 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarFGroup := X + 1; {$ENDIF}
AddStr ({$IFDEF MPLPARSER} 'fgroupname', {$ENDIF} iString, 30);
AddStr ({$IFDEF MPLPARSER} 'fgroupacs', {$ENDIF} iString, 30);
AddVar ({$IFDEF MPLPARSER} 'fgrouphidden', {$ENDIF} iBool);
End;
End;
End;

2171
mystic/mpl_execute.pas Normal file
View File

File diff suppressed because it is too large Load Diff

156
mystic/mpl_fileio.pas Normal file
View File

@ -0,0 +1,156 @@
{$I M_OPS.PAS}
Unit MPL_FileIO;
// all file io units should be compiled into one source file...
// also, make this ONLY allocate the size of the file if the file size is
// less than the buffer.
Interface
Const
MaxBufferSize = 64 * 1024;
Type
PCharRec = ^TCharRec;
TCharRec = Array[0..MaxBufferSize - 1] of Char;
PCharFile = ^TCharFile;
TCharFile = Object
BufSize : LongInt;
Buffer : PCharRec;
BufRead : LongInt;
BufStart : LongInt;
BufEnd : LongInt;
BufPos : LongInt;
InFile : File;
BufEOF : Boolean;
Constructor Init (BufferSize: LongInt);
Destructor Done;
Function Open (FN : String) : Boolean;
Procedure Close;
Function Read : Char;
Procedure BlockRead (Var Buf; Size: LongInt; Var Count: LongInt);
Procedure Seek (FP : LongInt);
Function FilePos : LongInt;
Function FileSize : LongInt;
Function EOF : Boolean;
Procedure FillBuffer;
End;
Implementation
Function TCharFile.FilePos : LongInt;
Begin
FilePos := BufStart + BufPos;
End;
Procedure TCharFile.FillBuffer;
Var
Start : LongInt;
Begin
Start := System.FilePos(InFile);
System.BlockRead (InFile, Buffer^[0], BufSize, BufRead);
BufStart := Start;
BufEnd := Start + BufRead;
BufPos := 0;
BufEOF := System.EOF(InFile);
End;
Constructor TCharFile.Init (BufferSize: LongInt);
Begin
BufSize := BufferSize;
BufStart := 0;
BufEnd := 0;
BufPos := 0;
BufEOF := False;
BufRead := 0;
Buffer := NIL;
End;
Destructor TCharFile.Done;
Begin
If Assigned(Buffer) Then Begin
FreeMem (Buffer, BufSize);
Buffer := NIL;
End;
End;
Function TCharFile.Open (FN : String) : Boolean;
Begin
Open := False;
FileMode := 66;
Assign (InFile, FN);
Reset (InFile, 1);
If IoResult <> 0 Then Exit;
If BufSize > System.FileSize(InFile) Then
BufSize := System.FileSize(InFile);
If Assigned(Buffer) Then Done;
GetMem (Buffer, BufSize);
FillBuffer;
Open := True;
End;
Procedure TCharFile.Close;
Begin
System.Close (InFile);
Done;
End;
Function TCharFile.Read : Char;
Begin
If BufPos >= BufSize Then FillBuffer;
Read := Buffer^[BufPos];
Inc (BufPos);
End;
Procedure TCharFile.BlockRead (Var Buf; Size: LongInt; Var Count: LongInt);
Begin
If BufPos + Size >= BufRead Then Begin
If Size > BufSize Then Size := BufSize;
System.Seek(InFile, BufStart + BufPos);
FillBuffer;
If BufRead < Size Then Size := BufRead;
End;
Move (Buffer^[BufPos], Buf, Size);
Inc (BufPos, Size);
Count := Size;
End;
Procedure TCharFile.Seek (FP : LongInt);
Begin
If (FP >= BufStart) and (FP < BufEnd) Then
BufPos := (BufEnd - (BufEnd - FP)) - BufStart
Else Begin
System.Seek(InFile, FP);
FillBuffer;
End;
End;
Function TCharFile.EOF : Boolean;
Begin
EOF := (BufStart + BufPos >= BufEnd) and BufEOF;
End;
Function TCharFile.FileSize : LongInt;
Begin
FileSize := System.FileSize(InFile);
End;
End.

294
mystic/mpl_types.pas Normal file
View File

@ -0,0 +1,294 @@
Type
TIdentTypes = (
iNone,
iString,
iChar,
iByte,
iShort,
iWord,
iInteger,
iLongInt,
iReal,
iBool,
iFile,
iRecord
);
TTokenOpsRec = (
opBlockOpen, // 1
opBlockClose, // 2
opVarDeclare, // 3
opStr, // 4
opChar, // 5
opByte, // 6
opShort, // 7
opWord, // 8
opInt, // 9
opLong, // 10
opReal, // 11
opBool, // 12
opSetVar, // 13
opLeftParan, // 14
opRightParan, // 15
opVariable, // 16
opOpenString, // 17
opCloseString, // 18
opProcDef, // 19
opProcExec, // 20
opParamSep, // 21
opFor, // 22
opTo, // 23
opDownTo, // 24
opTrue, // 25
opFalse, // 26
opEqual, // 27
opNotEqual, // 28
opGreater, // 29
opLess, // 30
opEqGreat, // 31
opEqLess, // 32
opStrAdd, // 33
opProcType, // 34
opIf, // 35
opElse, // 36
opWhile, // 37
opOpenNum, // 38
opCloseNum, // 39
opRepeat, // 40
opNot, // 41
opAnd, // 42
opOr, // 43
opStrArray, // 44
opArrDef, // 45
opStrSize, // 46
opVarNormal, // 47
opGoto, // 48
opHalt, // 49
opCase, // 50
opNumRange, // 51
opTypeRec, // 52
opBreak, // 53
opContinue, // 54
opUses, // 55
opExit, // 56
opNone // 57
);
Const
mplVer = '110';
mplVersion = '[MPX ' + mplVer +']' + #26;
mplVerLength = 10;
mplExtSource = '.mps';
mplExtExecute = '.mpx';
mplMaxInclude = 10;
mplMaxFiles = 20;
mplMaxIdentLen = 20;
mplMaxVars = 2500;
mplMaxGotos = 100;
mplMaxCaseNums = 20;
mplMaxVarDeclare = 20;
mplMaxArrayDem = 3; //cannot be changed yet
mplMaxProcParams = 8;
mplMaxRecords = 20;
mplMaxRecFields = 40;
mplMaxDataSize = 65535;
mplMaxConsts = 100;
Const
chNumber = ['0'..'9','.'];
chIdent1 = ['a'..'z','A'..'Z','_'];
chIdent2 = ['a'..'z','A'..'Z','0'..'9','_'];
chDigit = ['0'..'9'];
chHexDigit = ['0'..'9','A'..'F','a'..'f'];
{$IFNDEF MPLPARSER}
mpxEndOfFile = 1;
mpxInvalidFile = 2;
mpxVerMismatch = 3;
mpxUnknownOp = 4;
mpxMultiInit = 5;
mpxDivisionByZero = 6;
mpxMathematical = 7;
{$ELSE}
mpsEndOfFile = 1;
mpsFileNotfound = 2;
mpsFileRecurse = 3;
mpsOutputFile = 4;
mpsExpected = 5;
mpsUnknownIdent = 6;
mpsInStatement = 7;
mpsIdentTooLong = 8;
mpsExpIdentifier = 9;
mpsTooManyVars = 10;
mpsDupIdent = 11;
mpsOverMaxDec = 12;
mpsTypeMismatch = 13;
mpsSyntaxError = 14;
mpsStringNotClosed = 15;
mpsStringTooLong = 16;
mpsTooManyParams = 17;
mpsBadProcRef = 18;
mpsNumExpected = 19;
mpsToOrDowntoExp = 20;
mpsExpOperator = 21;
mpsOverArrayDim = 22;
mpsNoInitArray = 23;
mpsTooManyGotos = 24;
mpsDupLabel = 25;
mpsLabelNotFound = 26;
mpsFileParamVar = 27;
mpsBadFunction = 28;
mpsOperation = 29;
mpsOverMaxCase = 30;
mpsTooManyFields = 31;
mpsDataTooBig = 32;
mpsMaxConsts = 33;
{$ENDIF}
// ==========================================================================
{$IFDEF MPLPARSER}
Type
TTokenWordRec = (wBlockOpen, wBlockClose, wVarDeclare, wVarSep,
wSetVar, wLeftParan, wRightParan, wOpenString,
wCloseString, wStrAdd, wCharPrefix, wProcDef,
wOpenParam, wCloseParam, wParamVar, wParamSpec,
wFuncSpec, wParamSep, wFor, wTo,
wDownTo, wDo, wTrue, wFalse,
wOpEqual, wOpNotEqual, wOpGreater, wOpLess,
wOpEqGreat, wOpEqLess, wIf, wThen,
wElse, wWhile, wRepeat, wUntil,
wNot, wAnd, wOr, wOpenArray,
wCloseArray, wArrSep, wVarDef, wOpenStrSize,
wCloseStrSize, wGoto, wLabel, wHalt,
wVarSep2, wFuncDef, wArray, wCaseStart,
wCaseOf, wNumRange, wType, wConst,
wBreak, wContinue, wUses, wExit,
wHexPrefix, wExpAnd, wExpOr, wExpXor,
wExpShl, wExpShr);
{$ENDIF}
Const
{$IFDEF MPLPARSER}
tkv : Array[TIdentTypes] of String[mplMaxIdentLen] = (
'none', 'string', 'char', 'byte',
'shortint', 'word', 'integer', 'longint',
'real', 'boolean', 'file', 'record');
Type
TTokenWordType = Array[TTokenWordRec] of String[mplMaxIdentLen];
Const
wTokensPascal : TTokenWordType = (
'begin', 'end', 'var', ',',
':=', '(', ')', '''',
'''', '+', '#', 'procedure',
'(', ')', '+', ';',
':', ',', 'for', 'to',
'downto', 'do', 'true', 'false',
'=', '<>', '>', '<',
'>=', '<=', 'if', 'then',
'else', 'while', 'repeat', 'until',
'not', 'and', 'or', '[',
']', ',', '=', '[',
']', 'goto', ':', 'halt',
':', 'function', 'array', 'case',
'of', '..', 'type', 'const',
'break', 'continue', 'uses', 'exit',
'$', 'and', 'or', 'xor', 'shl', 'shr'
);
wTokensIPLC : TTokenWordType = (
'{', '}', '@', ',',
'=', '(', ')', '"',
'"', '+', '#', 'proc',
'(', ')', '+', ';',
':', ',', 'for', 'to',
'downto', 'do', 'true', 'false',
'==', '<>', '>', '<',
'>=', '<=', 'if', 'then',
'else', 'while', 'repeat', 'until',
'!', '&&', '||', '(',
')', ',', '=', '[',
']', 'goto', ':', 'halt',
':', 'func', 'array', 'switch',
'of', '..', 'type', 'const',
'break', 'continue', 'uses', 'exit',
'$', '&', '|', 'xor', '<<', '>>'
);
{$ENDIF}
vNums : Set of TIdentTypes = [iByte, iShort, iWord, iInteger, iLongInt, iReal];
vStrings : Set of TIdentTypes = [iChar, iString];
Type
{$IFNDEF MPLPARSER}
PStack = ^TStack;
TStack = Array[1..mplMaxDataSize] of Byte;
TArrayInfo = Array[1..mplMaxArrayDem] of Word;
(*
// MEMORY SAVING... could be 28 bytes per var?!?!
// could at least make a procrec that tvarrec links to via a pointer. would
// save us about 25 bytes per var... which is about half the memory. we
// could also remove IsProc var in TVar because we could just check to see
// if Proc : Pointer is assigned...
PProcInfoRec = ^TProcInfoRec;
TProcInfoRec = Record
Params : Array[1..mplMaxProcParams] of Char;
ParamID : Array[1..mplMaxProcParams] of Word;
NumParams : Byte;
Position : LongInt;
End;
*)
PVarRec = ^TVarRec;
TVarRec = Record
VarID : Word;
vType : TIdentTypes;
Params : Array[1..mplMaxProcParams] of Char;
NumParams : Byte;
pID : Array[1..mplMaxProcParams] of Word;
ProcPos : LongInt;
DataSize : Word;
VarSize : Word;
Data : PStack;
Kill : Boolean;
ArrPos : Byte;
ArrDim : TArrayInfo;
End;
PRecordRec = ^TRecordRec;
TRecordRec = Record
// RecID : Word; needed when Record variable type is added
RecStart : Word;
NumFields : Word;
End;
VarDataRec = Array[1..mplMaxVars] of PVarRec;
RecDataRec = Array[1..mplMaxRecords] of PRecordRec;
{$ELSE}
PVarRec = ^TVarRec;
TVarRec = Record
VarID : Word;
Ident : String[mplMaxIdentLen];
VType : TIdentTypes;
Params : Array[1..mplMaxProcParams] of Char;
NumParams : Byte;
InProc : Boolean;
Proc : Boolean;
ArrPos : Byte;
End;
PGotoRec = ^TGotoRec;
TGotoRec = Record
Ident : String[mplMaxIdentLen];
xPos : LongInt;
Stat : Byte;
End;
VarDataRec = Array[1..mplMaxVars] of PVarRec;
{$ENDIF}

93
mystic/mplc.pas Normal file
View File

@ -0,0 +1,93 @@
// ====================================================================
// Mystic BBS Software Copyright 1997-2012 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}
Program MPLC;
Uses
m_Output,
m_Strings,
Dos,
MPL_Compile;
Var
SavedX : Byte;
Console : TOutput;
WasError : Boolean;
Procedure Status (Info: TParserUpdateInfo);
Begin
Case Info.Mode of
StatusStart : Begin
Console.WriteStr('Compiling ' + Info.FileName + ' ... ');
SavedX := Console.CursorX;
End;
StatusUpdate : Begin
Console.CursorXY (SavedX, Console.CursorY);
Console.WriteStr (strPadL(strI2S(Info.Percent), 3, ' ') + '%');
End;
StatusDone : If Info.ErrorType = 0 Then Begin
Console.CursorXY (SavedX, Console.CursorY);
Console.WriteLine ('Success!');
End Else Begin
WasError := True;
Console.WriteLine(#13#10#13#10'Error in ' + Info.FileName + ' (Line:' + strI2S(Info.ErrorLine) + ', Col:' + strI2S(Info.ErrorCol) + '): ' + Info.ErrorText);
End;
End;
End;
Var
Parser : TParserEngine;
Dir : SearchRec;
Begin
WasError := False;
Console := TOutput.Create(True);
Console.WriteLine (#13#10'Mystic BBS Programming Language Compiler Version ' + mysVersion);
Console.WriteLine ('Copyright (C) 1997-2011 By James Coyle. All Rights Reserved.'#13#10);
If ParamCount = 0 Then
WriteLn ('MPLC [filename] or MPLC -ALL')
Else Begin
If Pos('-ALL', strUpper(ParamStr(1))) > 0 Then Begin
FindFirst ('*.mps', AnyFile - Directory - VolumeID, Dir);
While DosError = 0 Do Begin
Parser := TParserEngine.Create(Status);
If Not Parser.Compile(Dir.Name) Then Begin
Parser.Free;
Break;
End;
FindNext(Dir);
Parser.Free;
End;
FindClose(Dir);
End Else Begin
Parser := TParserEngine.Create(Status);
Parser.Compile(ParamStr(1));
Parser.Free;
End;
End;
Console.Free;
If WasError Then Halt(1);
End.

555
mystic/mystpack.pas Normal file
View File

@ -0,0 +1,555 @@
// 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/>.
Program MP;
{ when DELETEing a message, the pointers are one less than they should be }
{ should be fixed, but may cause other problems. commented out the last }
{ read updating in the msgkill part of the program }
{ also when a user is reading a base, it could cause MP to crash with an }
{ RTE 005: access violation error }
{$I M_OPS.PAS}
Uses
m_FileIO,
m_Strings,
m_DateTime,
CRT,
DOS;
{$I RECORDS.PAS}
Const
PackVer = '1.2';
Jam_Deleted = $80000000;
JamSubBufSize = 4096;
Type
JamSubBuffer = Array[1..JamSubBufSize] of Char;
JamHdrType = Record
Signature : Array[1..4] of Char;
Created : LongInt;
ModCounter : LongInt;
ActiveMsgs : LongInt;
PwdCRC : LongInt;
BaseMsgNum : LongInt;
HighWaterMark : Longint;
Extra : Array[1..996] of Char;
End;
JamMsgHdrType = Record
Signature : Array[1..4] of Char;
Rev : Word;
Resvd : Word;
SubFieldLen : LongInt;
TimesRead : LongInt;
MsgIdCrc : LongInt;
ReplyCrc : LongInt;
ReplyTo : LongInt;
ReplyFirst : LongInt;
ReplyNext : LongInt;
DateWritten : LongInt;
DateRcvd : LongInt;
DateArrived : LongInt;
MsgNumber : LongInt;
Attr1 : LongInt;
Attr2 : LongInt;
TextOfs : LongInt;
TextLen : LongInt;
PwdCrc : LongInt;
Cost : LongInt;
End;
JamIdxType = Record
MsgToCrc : LongInt;
HdrLoc : LongInt;
End;
JamLastType = Record
NameCrc : LongInt;
UserNum : LongInt;
LastRead : LongInt;
HighRead : LongInt;
End;
SubFieldType = Record
LoId : Word;
HiId : Word;
DataLen : LongInt;
Data : Array[1..1000] of Char;
End;
TxtType = Array[1..65000] of Char;
JamType = Record
Hdr : JamHdrType;
MsgHdr : JamMsgHdrType;
HdrFile : File;
Idx : JamIdxType;
IdxFile : File of JamIdxType;
Last : JamLastType;
LastFile : File of JamLastType;
TxtFile : File;
SubField : SubFieldType;
End;
Const
SpinStr : String[8] = ('\|/-\|/-');
SpinPos : Byte = 1;
SkipFirst : Boolean = False;
PackMsgs : Boolean = False;
Var
ConfigFile : File of RecConfig;
MBaseFile : File of MBaseRec;
Config : RecConfig;
MBase : MBaseRec;
Const
DATEC1970 = 2440588;
DATED0 = 1461;
DATED1 = 146097;
DATED2 = 1721119;
Procedure UnixToDT(SecsPast: LongInt; Var Dt: DateTime);
Var
DateNum : LongInt;
N1 : Word;
Begin
Datenum := (SecsPast Div 86400) + DATEc1970;
DateJ2G(DateNum, SmallInt(N1), SmallInt(DT.Month), SmallInt(DT.day));
DT.Year := N1;
SecsPast := SecsPast Mod 86400;
DT.Hour := SecsPast Div 3600;
SecsPast := SecsPast Mod 3600;
DT.Min := SecsPast Div 60;
DT.Sec := SecsPast Mod 60;
End;
Procedure PWrite (Str : String);
Var
A : Byte;
Code : String[2];
Begin
A := 1;
While A <= Length(Str) Do Begin
If (Str[A] = '|') and (A < Length(Str) - 1) Then Begin
Code := Copy(Str, A + 1, 2);
If (Code = '00') or (strS2I(Code) > 0) Then Begin
If strS2I(Code) < 16 Then
TextColor(strS2I(Code))
Else
TextBackground(strS2I(Code) - 16);
End Else
Write(Str[A] + Code);
Inc (A, 2);
End Else
Write(Str[A]);
Inc(A);
End;
End;
Procedure PWriteLN (Str : String);
Begin
PWrite (Str + #13#10);
End;
Procedure UpdateSpin;
Begin
Write (#8 + SpinStr[SpinPos]);
Inc (SpinPos);
If SpinPos > 8 Then SpinPos := 1;
End;
Procedure PackJAMBase (Var TotalKilled : LongInt; Var SavedBytes : LongInt);
Var
BasePath : String;
OldHdrFile : File;
OldTxtFile : File;
OldIdxFile : File of JamIdxType;
NewHdrFile : File;
NewTxtFile : File;
NewIdxFile : File of JamIdxType;
TmpHdrFile : File;
LastFile : File of JamLastType;
Last : JamLastType;
SigHdr : JamHdrType;
MsgHdr : JamMsgHdrType;
TmpSigHdr : JamHdrType;
TmpMsgHdr : JamMsgHdrType;
MsgIdx : JamIdxType;
TxtBuf : ^TxtType;
SubField : SubFieldType;
Count : LongInt;
Killed : Boolean;
KillOffset : LongInt;
LimitKill : Boolean;
TotalMsgs : LongInt;
MsgDateTime : DateTime;
Temp : LongInt;
HaveHdr : Boolean;
Begin
PWrite ('|07Processing |08-> |07' + strPadR(MBase.Name, 35, ' ') + '|08 -> |07');
BasePath := MBase.Path + MBase.FileName;
Assign (OldHdrFile, BasePath + '.jhr');
Assign (OldTxtFile, BasePath + '.jdt');
Assign (OldIdxFile, BasePath + '.jdx');
{$I-} Reset (OldHdrFile, 1); {$I+}
If IOResult <> 0 Then Exit;
{$I-} Reset (OldTxtFile, 1); {$I+}
If IOResult <> 0 Then Begin
Close (OldHdrFile);
Exit;
End;
{$I-} Reset (OldIdxFile); {$I+}
If IoResult <> 0 Then Begin
Close (OldHdrFile);
Close (OldTxtFile);
Exit;
End;
Assign (LastFile, BasePath + '.jlr');
{$I-} Reset (LastFile); {$I+}
If IoResult <> 0 Then ReWrite (LastFile);
Close (LastFile);
Assign (NewHdrFile, BasePath + '._hr');
ReWrite (NewHdrFile, 1);
Assign (NewTxtFile, BasePath + '._dt');
ReWrite (NewTxtFile, 1);
Assign (NewIdxFile, BasePath + '._dx');
ReWrite (NewIdxFile);
BlockRead (OldHdrFile, SigHdr, SizeOf(SigHdr));
Inc (SigHdr.ModCounter);
BlockWrite (NewHdrFile, SigHdr, SizeOf(SigHdr));
If SigHdr.ActiveMsgs > MBase.MaxMsgs Then
KillOffset := SigHdr.ActiveMsgs - MBase.MaxMsgs
Else
KillOffset := 0;
TotalMsgs := 0;
TotalKilled := 0;
New (TxtBuf);
While Not Eof(OldIdxFile) Do Begin
UpdateSpin;
Read (OldIdxFile, MsgIdx);
If MsgIdx.HdrLoc = -1 Then Begin
Killed := True;
LimitKill := False;
HaveHdr := False;
End Else Begin
Seek (OldHdrFile, MsgIdx.HdrLoc);
BlockRead (OldHdrFile, MsgHdr, SizeOf(MsgHdr));
LimitKill := False;
Killed := MsgHdr.Attr1 and Jam_Deleted <> 0;
HaveHdr := True;
If MBase.MaxAge > 0 Then Begin
UnixToDT (MsgHdr.DateWritten, MsgDateTime);
PackTime (MsgDateTime, Temp);
LimitKill := DaysAgo(Temp) > MBase.MaxAge;
Killed := Killed or LimitKill;
End;
If MBase.MaxMsgs > 0 Then
If KillOffset > 0 Then Begin
Dec (KillOffset);
LimitKill := True;
Killed := True;
End;
If SkipFirst and (MBase.NetType = 0) and (TotalMsgs = 0) and (MsgHdr.Attr1 and Jam_Deleted = 0) Then
Killed := False;
End;
If Killed Then Begin
Inc (TotalKilled);
(*
Reset (LastFile);
While Not Eof(LastFile) Do Begin
Read (LastFile, Last);
If (Last.LastRead > TotalMsgs) And Not LimitKill Then Begin
Dec (Last.LastRead);
Seek (LastFile, FilePos(LastFile) - 1);
Write (LastFile, Last);
End;
End;
Close (LastFile);
*)
If HaveHdr And (MsgHdr.ReplyFirst <> 0) Then Begin
Assign (TmpHdrFile, BasePath + '.jhr');
Reset (TmpHdrFile, 1);
BlockRead (TmpHdrFile, TmpSigHdr, SizeOf(TmpSigHdr));
While Not Eof(TmpHdrFile) Do Begin
BlockRead (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
If TmpMsgHdr.ReplyTo = MsgHdr.MsgNumber Then Begin
TmpMsgHdr.ReplyTo := 0;
Seek (TmpHdrFile, FilePos(TmpHdrFile) - SizeOf(TmpMsgHdr));
BlockWrite (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
End;
Seek (TmpHdrFile, FilePos(TmpHdrFile) + TmpMsgHdr.SubFieldLen);
End;
Close (TmpHdrFile);
End;
End Else Begin
Inc (TotalMsgs);
If TotalKilled > 0 Then Begin
Reset (LastFile);
While Not Eof(LastFile) Do Begin
Read (LastFile, Last);
If Last.LastRead = MsgHdr.MsgNumber Then Begin
Last.LastRead := TotalMsgs;
Seek (LastFile, FilePos(LastFile) - 1);
Write (LastFile, Last);
End;
End;
Close (LastFile);
End;
If (TotalKilled > 0) and (MsgHdr.ReplyFirst <> 0) Then Begin
Assign (TmpHdrFile, BasePath + '.jhr');
Reset (TmpHdrFile, 1);
BlockRead (TmpHdrFile, TmpSigHdr, SizeOf(TmpSigHdr));
While Not Eof(TmpHdrFile) Do Begin
BlockRead (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
If TmpMsgHdr.ReplyTo = MsgHdr.MsgNumber Then Begin
TmpMsgHdr.ReplyTo := TotalMsgs;
Seek (TmpHdrFile, FilePos(TmpHdrFile) - SizeOf(TmpMsgHdr));
BlockWrite (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
End;
Seek (TmpHdrFile, FilePos(TmpHdrFile) + TmpMsgHdr.SubFieldLen);
End;
Close (TmpHdrFile);
End;
If (TotalKilled > 0) and (MsgHdr.ReplyTo <> 0) Then Begin
Assign (TmpHdrFile, BasePath + '._hr');
Reset (TmpHdrFile, 1);
BlockRead (TmpHdrFile, TmpSigHdr, SizeOf(TmpSigHdr));
While Not Eof(TmpHdrFile) Do Begin
BlockRead (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
If TmpMsgHdr.ReplyFirst = MsgHdr.MsgNumber Then Begin
TmpMsgHdr.ReplyFirst := TotalMsgs;
Seek (TmpHdrFile, FilePos(TmpHdrFile) - SizeOf(TmpMsgHdr));
BlockWrite (TmpHdrFile, TmpMsgHdr, SizeOf(TmpMsgHdr));
End;
Seek (TmpHdrFile, FilePos(TmpHdrFile) + TmpMsgHdr.SubFieldLen);
End;
Close (TmpHdrFile);
End;
MsgHdr.MsgNumber := TotalMsgs;
MsgIdx.HdrLoc := FilePos(NewHdrFile);
(* write text from old file to new file *)
If MsgHdr.TextLen > 65000 Then MsgHdr.TextLen := 65000;
// Why did I put this limitation here? Prob should be removed
Seek (OldTxtFile, MsgHdr.TextOfs);
BlockRead (OldTxtFile, TxtBuf^, MsgHdr.TextLen);
MsgHdr.TextOfs := FileSize(NewTxtFile);
BlockWrite (NewTxtFile, TxtBuf^, MsgHdr.TextLen);
(* write header from old to new file *)
BlockWrite (NewHdrFile, MsgHdr, SizeOf(MsgHdr));
(* write subfield data if it exists *)
If MsgHdr.SubFieldLen > 0 Then Begin
Count := 1;
While (Count <= MsgHdr.SubFieldLen) Do Begin
BlockRead (OldHdrFile, SubField, 8);
BlockRead (OldHdrFile, SubField.Data, SubField.DataLen);
BlockWrite (NewHdrFile, SubField, 8);
BlockWrite (NewHdrFile, SubField.Data, SubField.DataLen);
Inc (Count, 8 + SubField.DataLen);
End;
End;
(* write new index to index file *)
Write (NewIdxFile, MsgIdx);
End;
End;
Dispose (TxtBuf);
SigHdr.ActiveMsgs := TotalMsgs;
SigHdr.BaseMsgNum := 1;
Reset (NewHdrFile, 1);
BlockWrite (NewHdrFile, SigHdr, SizeOf(SigHdr));
SavedBytes := (FileSize(OldHdrFile) - FileSize(NewHdrFile)) +
(FileSize(OldTxtFile) - FileSize(NewTxtFile)) +
((FileSize(OldIdxFile) - FileSize(NewIdxFile)) * SizeOf(MsgIdx));
Close (OldHdrFile);
Close (OldTxtFile);
Close (OldIdxFile);
Close (NewHdrFile);
Close (NewTxtFile);
Close (NewIdxFile);
Erase (OldHdrFile);
Erase (OldTxtFile);
Erase (OldIdxFile);
ReName (NewHdrFile, BasePath + '.jhr');
ReName (NewTxtFile, BasePath + '.jdt');
ReName (NewIdxFile, BasePath + '.jdx');
If TotalKilled > 0 Then Begin
Reset (LastFile);
While Not Eof(LastFile) Do Begin
Read (LastFile, Last);
If Last.LastRead > TotalMsgs Then Last.LastRead := TotalMsgs;
If Last.HighRead > Last.LastRead Then Last.HighRead := Last.LastRead;
Seek (LastFile, FilePos(LastFile) - 1);
Write (LastFile, Last);
End;
Close (LastFile);
End;
End;
Procedure ShowHelp;
Begin
WriteLn ('Invalid command line options');
WriteLn;
WriteLn ('-PACK : Pack all jam message bases');
WriteLn ('-SKIPFIRST : Skips the first message of each local message base');
WriteLn;
PWriteLn ('|12NOTE: This program can sometimes crash if users are online.|07');
Halt(1);
End;
Var
TotalMsgs : LongInt;
TotalBytes : LongInt;
Msgs : LongInt;
Bytes : LongInt;
Count : Byte;
Str : String;
Begin
FileMode := 66;
ClrScr;
PWriteLn ('|08-> |15MYSTPACK ' + PackVer + ' : JAM message base packer');
PWriteLn ('|08-> |07Compatible with Mystic BBS software v' + mysVersion);
PWriteLn ('|08ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|07');
WriteLn;
Window (1, 5, 80, 24);
If ParamCount = 0 Then ShowHelp;
For Count := 1 to ParamCount Do Begin
Str := strUpper(ParamStr(Count));
If Str = '-PACK' Then
PackMsgs := True
Else
If Str = '-SKIPFIRST' Then
SkipFirst := True
Else
ShowHelp;
End;
Assign (ConfigFile, 'mystic.dat');
{$I-} Reset (ConfigFile); {$I+}
If IoResult <> 0 Then Begin
WriteLn ('ERROR: Unable to read MYSTIC.DAT. Run from root Mystic directory');
Halt(1);
End;
Read (ConfigFile, Config);
Close (ConfigFile);
If Config.DataChanged <> mysDataChanged Then Begin
WriteLn('ERROR: Data files are not current and must be upgraded.');
Halt(1);
End;
Assign (MBaseFile, Config.DataPath + 'mbases.dat');
{$I-} Reset(MBaseFile); {$I+}
If IoResult <> 0 Then Begin
WriteLn ('ERROR: Unable to read message area data');
Halt(1);
End;
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If MBase.BaseType = 0 Then Begin
PackJAMBase(Msgs, Bytes);
WriteLn (#8 + 'Killed ', Msgs, '; ', Bytes, ' bytes');
Inc (TotalMsgs, Msgs);
Inc (TotalBytes, Bytes);
End;
End;
Close (MBaseFile);
WriteLn;
PWriteLn ('|08[|07-|08] |07Killed |15' + strI2S(TotalMsgs) + '|07 Msgs; Removed |15' + strI2S(TotalBytes) + '|07 bytes');
Window (1, 1, 80, 25);
End.

697
mystic/records.pas Normal file
View File

@ -0,0 +1,697 @@
{
===========================================================================
Mystic BBS Software Copyright (C) 1997-2012 By James Coyle
===========================================================================
File | RECORDS.PAS
Desc | This file holds the data file records for all data files used
within Mystic BBS software. Mystic BBS is compiled with the
latest version of Free Pascal for all platforms.
===========================================================================
}
Const
mysSoftwareID = 'Mystic';
mysCopyYear = '1997-2012';
mysVersion = '1.10 A11';
mysDataChanged = '1.10 A11';
{$IFDEF WIN32}
PathChar = '\';
LineTerm = #13#10;
OSID = 'Windows';
OSType = 0;
{$ENDIF}
{$IFDEF LINUX}
PathChar = '/';
LineTerm = #10;
OSID = 'Linux';
OSType = 1;
{$ENDIF}
{$IFDEF DARWIN}
PathChar = '/';
LineTerm = #10;
OSID = 'OSX';
OSType = 2;
{$ENDIF}
mysMaxAcsSize = 30; // Max ACS string size
mysMaxPathSize = 80;
mysMaxMsgLines = 500; // Max message base lines
mysMaxInputHistory = 5; // Input history stack size
mysMaxFileDescLen = 50;
mysMaxBatchQueue = 50;
mysMaxVoteQuestion = 20; { Max number of voting questions }
mysMaxMenuNameLen = 20;
mysMaxMenuCmds = 75; { Maximum menu commands per menu }
mysMaxLanguageStr = 478; { Total # of strings in language file }
Type
SmallWord = System.Word;
Integer = SmallInt; { force Integer to be a 2-byte signed }
Word = SmallWord;
RecMessageText = Array[1..mysMaxMsgLines] of String[79];
AccessFlagType = Set of 1..25; { flags A to Z }
RecEchoMailAddr = Record { FidoNet-style network address }
Zone,
Net,
Node,
Point : Word;
End;
RecUserOptionalField = Record
Ask : Boolean;
Desc : String[12];
iType : Byte;
iField : Byte;
iMax : Byte;
End;
RecConfig = Record // MYSTIC.DAT
// INTERNALS
DataChanged : String[8]; // Version of last data change
SystemCalls : LongInt; // system caller number
UserIdxPos : LongInt; // permanent user # position
// SYSTEM PATHS
SystemPath : String[mysMaxPathSize];
DataPath : String[mysMaxPathSize];
LogsPath : String[mysMaxPathSize];
MsgsPath : String[mysMaxPathSize];
AttachPath : String[mysMaxPathSize];
ScriptPath : String[mysMaxPathSize];
QwkPath : String[mysMaxPathSize];
SemaPath : String[mysMaxPathSize];
TemplatePath : String[mysMaxPathSize];
MenuPath : String[mysMaxPathsize];
TextPath : String[mysMaxPathSize];
WebPath : String[mysMaxPathSize];
// GENERAL SETTINGS
BBSName : String[30];
SysopName : String[30];
SysopPW : String[15];
SystemPW : String[15];
FeedbackTo : String[30];
Inactivity : Word;
LoginTime : Byte;
LoginAttempts : Byte;
PWAttempts : Byte;
PWChange : Word;
PWInquiry : Boolean;
DefStartMenu : String[20];
DefFallMenu : String[20];
DefThemeFile : String[20];
DefTermMode : Byte;
DefScreenSize : Byte;
DefScreenCols : Byte;
UseMatrix : Boolean;
MatrixMenu : String[20];
MatrixPW : String[15];
MatrixAcs : String[mysMaxAcsSize];
AcsSysop : String[mysMaxAcsSize];
AcsInvisLogin : String[mysMaxAcsSize];
AcsSeeInvis : String[mysMaxAcsSize];
AcsMultiLogin : String[mysMaxAcsSize];
SysopMacro : Array[1..4] of String[80]; // Sysop Macros
ChatStart : SmallInt; // Chat hour start
ChatEnd : SmallInt; // Chat hour end: mins since midnight
ChatFeedback : Boolean; // E-mail sysop if page isn't answered
ChatLogging : Boolean; // Record SysOp chat to CHAT.LOG?
UseStatusBar : Boolean;
StatusColor1 : Byte;
StatusColor2 : Byte;
StatusColor3 : Byte;
// NEW USER SETTINGS
AllowNewUsers : Boolean;
NewUserSec : SmallInt;
NewUserPW : String[15];
NewUserEMail : Boolean;
StartMGroup : Word;
StartFGroup : Word;
UseUSAPhone : Boolean;
UserNameFormat : Byte;
UserDateType : Byte; // 1=MM/DD/YY 2=DD/MM/YY 3=YY/DD/MM 4=Ask
UserEditorType : Byte; // 0=Line 1=Full 2=Ask
UserHotKeys : Byte; // 0=no 1=yes 2=ask
UserFullChat : Byte; // 0=no 1=yes 2=ask
UserFileList : Byte; // 0=Normal 1=Lightbar 2=Ask
UserReadType : Byte; // 0=normal 1=ansi 2=ask
UserMailIndex : Byte;
UserReadIndex : Byte;
UserQuoteWin : Byte;
AskTheme : Boolean;
AskRealName : Boolean;
AskAlias : Boolean;
AskStreet : Boolean;
AskCityState : Boolean;
AskZipCode : Boolean;
AskHomePhone : Boolean;
AskDataPhone : Boolean;
AskBirthdate : Boolean;
AskGender : Boolean;
AskEmail : Boolean;
AskUserNote : Boolean;
AskScreenSize : Boolean;
AskScreenCols : Boolean;
OptionalField : Array[1..10] of RecUserOptionalField;
// MESSAGE BASE SETTINGS
MCompress : Boolean;
MColumns : Byte;
MShowHeader : Boolean; // re-show msg header after pause
MShowBases : Boolean;
MaxAutoSig : Byte;
qwkMaxBase : SmallInt;
qwkMaxPacket : SmallInt;
qwkArchive : String[4];
qwkBBSID : String[8];
qwkWelcome : String[mysMaxPathSize];
qwkNews : String[mysMaxPathSize];
qwkGoodbye : String[mysMaxPathSize];
Origin : String[50]; // Default origin line
NetAddress : Array[1..30] of RecEchoMailAddr; // echomail addresses
NetDesc : Array[1..30] of String[20]; // echomail network description
NetCrash : Boolean;
NetHold : Boolean;
NetKillSent : Boolean;
ColorQuote : Byte;
ColorText : Byte;
ColorTear : Byte;
ColorOrigin : Byte;
ColorKludge : Byte;
AcsCrossPost : String[mysMaxAcsSize];
AcsFileAttach : String[mysMaxAcsSize];
AcsNodeLookup : String[mysMaxAcsSize];
FSEditor : Boolean;
FSCommand : String[60];
// FILE BASE SETTINGS
FCompress : Boolean;
FColumns : Byte;
FShowHeader : Boolean;
FShowBases : Boolean;
FDupeScan : Byte; // 0=no 1=yes 2=global
UploadBase : Word; // Default upload file base
ImportDIZ : Boolean;
FreeUL : LongInt;
FreeCDROM : LongInt;
MaxFileDesc : Byte;
FCommentLines : Byte;
FCommentLen : Byte;
TestUploads : Boolean;
TestPassLevel : Byte;
TestCmdLine : String[mysMaxPathSize];
AcsValidate : String[mysMaxAcsSize];
AcsSeeUnvalid : String[mysMaxAcsSize];
AcsDLUnvalid : String[mysMaxAcsSize];
AcsSeeFailed : String[mysMaxAcsSize];
AcsDLFailed : String[mysMaxAcsSize];
// INTERNET SERVER SETTINGS
inetDomain : String[25];
inetIPBlocking : Boolean;
inetIPLogging : Boolean;
inetSMTPUse : Boolean;
inetSMTPPort : Word;
inetSMTPMax : Word;
inetSMTPDupes : Byte;
inetPOP3Use : Boolean;
inetPOP3Port : Word;
inetPOP3Max : Word;
inetPOP3Dupes : Byte;
inetTNUse : Boolean;
inetTNPort : Word;
inetTNMax : Byte;
inetTNDupes : Byte;
inetFTPUse : Boolean;
inetFTPPort : Word;
inetFTPMax : Word;
inetFTPDupes : Byte;
inetFTPPortMin : Word;
inetFTPPortMax : Word;
inetFTPAnon : Boolean;
inetFTPTimeout : Word;
inetNNTPUse : Boolean;
inetNNTPPort : Word;
inetNNTPMax : Word;
inetNNTPDupes : Byte;
// UNSORTED
Reserved : Array[1..491] of Char;
End;
Const
UserLockedOut = $01;
UserNoRatio = $02;
UserDeleted = $04;
UserNoKill = $08;
UserNoCaller = $10;
UserNoPWChange = $20;
//FUTURE DATA FILE UPDATES NEEDED
//LASTON needs optional1-10 compare to Mystic2
//FBASE
// ACS to comment on file
//FDIR
// pointer to comments record
// rating moved here from comment record
// file deletes and mbbsutil need updating to deal with comments
//MBASES
// expand header filename[20]
// add template[20]
// add msgbase sponser[30]
// add newsname[80]
// add colorkludge[b]
// add flags[l] merge in useReal
// flags:
// userealname, forced, allow autosig, allow attachments, kludge filter
// remove password?
// ACS to s[30]
//MENUS
// remove fallback?
// (flags)
// menu descriptions
// node action
// command timer
// input chars
// (commands)
// TBD compare to mystic 2
// VOTING: expand ACS to s[30]
// LANGREC
// example path sizes
// add script path?
// compare to mystic 2 for fallback stuff?
// rename to THEME
Type
RecUser = Record { USERS.DAT }
PermIdx : LongInt; // permanent user number
Flags : Byte; { User Flags }
Handle : String[30]; { Handle }
RealName : String[30]; { Real Name }
Password : String[15]; { Password }
Address : String[30]; { Address }
City : String[25]; { City }
ZipCode : String[9]; { Zipcode }
HomePhone : String[15]; { Home Phone }
DataPhone : String[15]; { Data Phone }
Birthday : LongInt;
Gender : Char; { M> Male F> Female }
Email : String[60]; { email address }
Optional : Array[1..10] of String[60];
UserInfo : String[30]; { user comment field }
Theme : String[20]; { user's language file }
AF1 : AccessFlagType;
AF2 : AccessFlagType; { access flags set #2 }
Security : SmallInt; { Security Level }
Expires : String[8];
ExpiresTo : Byte;
LastPWChange : String[8];
StartMenu : String[20]; { Start menu for user }
Archive : String[4]; { default archive extension }
QwkFiles : Boolean; { Include new files in QWK? }
DateType : Byte; { Date format (see above) }
ScreenSize : Byte; { user's screen length }
ScreenCols : Byte;
PeerIP : String[20];
PeerName : String[50];
FirstOn : LongInt; { Date/Time of First Call }
LastOn : LongInt; { Date/Time of Last Call }
Calls : LongInt; { Number of calls to BBS }
CallsToday : SmallInt; { Number of calls today }
DLs : SmallInt; { # of downloads }
DLsToday : SmallInt; { # of downloads today }
DLk : LongInt; { # of downloads in K }
DLkToday : LongInt; { # of downloaded K today }
ULs : LongInt; { total number of uploads }
ULk : LongInt; { total number of uploaded K }
Posts : LongInt; { total number of msg posts }
Emails : LongInt; { total number of sent email }
TimeLeft : LongInt; { time left online for today }
TimeBank : SmallInt; { number of mins in timebank }
FileRatings : LongInt;
FileComment : LongInt;
LastFBase : Word; { Last file base }
LastMBase : Word; { Last message base }
LastMGroup : Word; { Last group accessed }
LastFGroup : Word; { Last file group accessed }
Vote : Array[1..mysMaxVoteQuestion] of Byte; { Voting booth data }
EditType : Byte; { 0 = Line, 1 = Full, 2 = Ask }
FileList : Byte; { 0 = Normal, 1 = Lightbar }
SigUse : Boolean; { Use auto-signature? }
SigOffset : LongInt; { offset to sig in AUTOSIG.DAT }
SigLength : Byte; { number of lines in sig }
HotKeys : Boolean; { does user have hotkeys on? }
MReadType : Byte; { 0 = line 1 = full 2 = ask }
UseLBIndex : Boolean; { use lightbar index? }
UseLBQuote : Boolean; { use lightbar quote mode }
UseLBMIdx : Boolean; { use lightbar index in email? }
UseFullChat : Boolean; { use full screen teleconference }
Credits : LongInt;
Reserved : Array[1..393] of Byte;
End;
EventRec = Record { EVENTS.DAT }
Active : Boolean; { Is event active? }
Name : String[30]; { Event Name }
Forced : Boolean; { Is this a forced event }
ErrLevel : Byte; { Errorlevel to Exit }
ExecTime : SmallInt; { Minutes after midnight }
Warning : Byte; { Warn user before the event }
Offhook : Boolean; { Offhook modem for event? }
Node : Byte; { Node number. 0 = all }
LastRan : LongInt; { Last time event was ran }
End;
(* SECURITY.DAT in the data directory holds 255 records, one for each *)
(* possible security level. *)
RecSecurity = Record { SECURITY.DAT }
Desc : String[30]; { Description of security level }
Time : SmallInt; { Time online (mins) per day }
MaxCalls : SmallInt; { Max calls per day }
MaxDLs : SmallInt; { Max downloads per day }
MaxDLk : SmallInt; { Max download kilobytes per day }
MaxTB : SmallInt; { Max mins allowed in time bank }
DLRatio : Byte; { Download ratio (# of DLs per UL) }
DLKRatio : SmallInt; { DL K ratio (# of DLed K per UL K }
AF1 : AccessFlagType; { Access flags for this level A-Z }
AF2 : AccessFlagType; { Access flags #2 for this level }
Hard : Boolean; { Do a hard AF upgrade? }
StartMenu : String[20]; { Start Menu for this level }
PCRatio : SmallInt; { Post / Call ratio per 100 calls }
Expires : Word;
ExpiresTo : Word;
Posts : Word;
PostsTo : Word;
Download : Word;
DownloadTo : Word;
Upload : Word;
UploadTo : Word;
Calls : Word;
CallsTo : Word;
Reserved : Array[1..64] of Byte;
End;
RecArchive = Record { ARCHIVE.DAT }
OSType : Byte;
Active : Boolean;
Desc : String[30];
Ext : String[4];
Pack : String[80];
Unpack : String[80];
View : String[80];
End;
MScanRec = Record { <Message Base Path> *.SCN }
NewScan : Byte; { Include this base in new scan? }
QwkScan : Byte; { Include this base in qwk scan? }
End;
MBaseRec = Record { MBASES.DAT }
Name : String[40]; { Message base name }
QWKName : String[13]; { QWK (short) message base name }
FileName : String[40]; { Message base file name }
Path : String[40]; { Path where files are stored }
BaseType : Byte; { 0 = JAM, 1 = Squish }
NetType : Byte; { 0 = Local 1 = EchoMail }
{ 2 = UseNet 3 = NetMail }
PostType : Byte; { 0 = Public 1 = Private }
ACS, { ACS required to see this base }
ReadACS, { ACS required to read messages }
PostACS, { ACS required to post messages }
SysopACS : String[20]; { ACS required for sysop options }
Password : String[15]; { Password for this message base }
ColQuote : Byte; { Quote text color }
ColText : Byte; { Text color }
ColTear : Byte; { Tear line color }
ColOrigin: Byte; { Origin line color }
NetAddr : Byte; { Net AKA to use for this base }
Origin : String[50]; { Net origin line for this base }
UseReal : Boolean; { Use real names? }
DefNScan : Byte; { 0 = off, 1 = on, 2 = always }
DefQScan : Byte; { 0 = off, 1 = on, 2 = always }
MaxMsgs : Word; { Max messages to allow }
MaxAge : Word; { Max age of messages before purge }
Header : String[8]; { Display Header file name }
Index : SmallInt; { QWK index - NEVER CHANGE THIS }
End;
FScanRec = Record { <Data Path> *.SCN }
NewScan : Byte; { Include this base in new scan? }
LastNew : LongInt; { Last file scan (packed datetime)}
End;
FBaseRec = Record { FBASES.DAT }
Name : String[40]; { File base name }
FtpName : String[60]; { FTP directory name }
Filename : String[40]; { File name }
DispFile : String[20]; { Pre-list display file name }
Template : String[20]; { ansi file list template }
ListACS, { ACS required to see this base }
FtpACS, { ACS to see in FTP directory }
SysopACS, { ACS required for SysOp functions}
ULACS, { ACS required to upload files }
DLACS : String[mysMaxAcsSize]; { ACS required to download files }
Path : String[120]; { Path where files are stored }
Password : String[20]; { Password to access this base }
DefScan : Byte; { Default New Scan Setting }
ShowUL : Boolean;
IsCDROM : Boolean;
IsFREE : Boolean;
End;
// make flags and merge in shouul, iscdrom,isfree, etc
(* The file directory listing are stored as <FBaseRec.FileName>.DIR in *)
(* the data directory. Each record stores the info on one file. File *)
(* descriptions are stored in <FBaseRec.FileName>.DES in the data *)
(* directory. FDirRec.Pointer points to the file position in the .DES *)
(* file where the file description for the file begins. FDirRec.Lines is *)
(* the number of lines in the file description. Each line is stored as a *)
(* Pascal-like string (ie the first byte is the length of the string, *)
(* followed by text which is the length of the first byte *)
Const
FDirOffline = $01;
FDirInvalid = $02;
FDirDeleted = $04;
FDirFailed = $08;
FDirFree = $10;
Type
FDirRec = Record { *.DIR }
FileName : String[70]; { File name }
Size : LongInt; { File size (in bytes) }
DateTime : LongInt; { Date and time of upload }
Uploader : String[30]; { User name who uploaded the file }
Flags : Byte; { Set of FDIRFLAGS (see above) }
Pointer : LongInt; { Pointer to file description }
Lines : Byte; { Number of description lines }
DLs : Word; { # of times this file was downloaded}
End;
FDirCommentRec = Record { .FCI and .FCT in DATA directory }
UserName : String[30];
Rating : Byte;
Date : LongInt;
Lines : Word;
End;
RecGroup = Record { GROUP_*.DAT }
Name : String[30]; { Group name }
ACS : String[30]; { ACS required to access group }
Hidden : Boolean;
End;
(* Mystic BBS stores it's menu files as text files. They *)
(* have been stored this way to make it possible to edit them with a text *)
(* editor (which is sometimes easier then using the menu editor). The *)
(* following records do not need to be used, but provide one way of *)
(* reading a menu into a record. *)
MenuRec = Record
Header : String[255];
Prompt : String[255];
DispCols : Byte;
ACS : String[20];
Password : String[15];
TextFile : String[8];
FallBack : String[8];
MenuType : Byte; { 0 = standard, 1 = lightbar, 2 = lightbar grid }
InputType : Byte; { 0 = user setting, 1 = longkey, 2 = hotkey }
DoneX : Byte;
DoneY : Byte;
Global : Byte; { 0 = no, 1 = yes }
End;
MenuCmdRec = Record
Text : String[79];
HotKey : String[8];
LongKey : String[8];
ACS : string[20];
Command : String[2];
Data : String[79];
X : Byte;
Y : Byte;
cUp : Byte;
cDown : Byte;
cLeft : Byte;
cRight : Byte;
LText : String[79];
LHText : String[79];
End;
PercentRec = Record // percentage bar record
BarLen : Byte;
LoChar : Char;
LoAttr : Byte;
HiChar : Char;
HiAttr : Byte;
End;
LangRec = Record { LANGUAGE.DAT }
FileName : String[8]; { Language file name }
Desc : String[30]; { Language description }
TextPath : String[40]; { Path where text files are stored }
MenuPath : String[40]; { Path where menu files are stored }
okASCII : Boolean; { Allow ASCII }
okANSI : Boolean; { Allow ANSI }
BarYN : Boolean; { Use Lightbar Y/N with this lang }
FieldCol1 : Byte; { Field input color }
FieldCol2 : Byte;
FieldChar : Char;
EchoCh : Char; { Password echo character }
QuoteColor : Byte; { Color for quote lightbar }
TagCh : Char; { File Tagged Char }
FileHi : Byte; { Color of file search highlight }
FileLo : Byte; { Non lightbar description color }
NewMsgChar : Char; { Lightbar Msg Index New Msg Char }
VotingBar : PercentRec; { voting booth bar }
FileBar : PercentRec; { file list bar }
MsgBar : PercentRec; { lightbar msg reader bar }
GalleryBar : PercentRec;
Reserved : Array[1..95] of Byte; { RESERVED }
End;
BBSListRec = Record
cType : Byte;
Phone : String[15];
Telnet : String[40];
BBSName : String[30];
Location : String[25];
SysopName : String[30];
BaudRate : String[6];
Software : String[10];
Deleted : Boolean;
AddedBy : String[30];
Verified : LongInt;
Res : Array[1..6] of Byte;
End;
(* ONELINERS.DAT found in the data directory. This file contains all the
one-liner data. It can be any number of records in size. *)
OneLineRec = Record
Text : String[79];
From : String[30];
End;
(* Each record of VOTES.DAT is one question. Mystic only allows for up *)
(* to 20 questions. *)
VoteRec = Record { VOTES.DAT in DATA directory }
Votes : SmallInt; { Total votes for this question }
AnsNum : Byte; { Total # of Answers }
User : String[30]; { User name who added question }
ACS : String[20]; { ACS to see this question }
AddACS : String[20]; { ACS to add an answer }
ForceACS : String[20]; { ACS to force voting of question }
Question : String[79]; { Question text }
Answer : Array[1..15] of Record { Array[1..15] of Answer data }
Text : String[40]; { Answer text }
Votes : SmallInt; { Votes for this answer }
End;
End;
(* CHATx.DAT is created upon startup, where X is the node number being *)
(* loaded. These files are used to store all the user information for a *)
(* node. *)
ChatRec = Record { CHATx.DAT }
Active : Boolean; { Is there a user on this node? }
Name : String[30]; { User's name on this node }
Action : String[40]; { User's action on this node }
Location : String[30]; { User's City/State on this node }
Gender : Char; { User's gender }
Age : Byte; { User's age }
Baud : String[6]; { User's baud rate }
Invisible : Boolean; { Is node invisible? }
Available : Boolean; { Is node available? }
InChat : Boolean; { Is user in multi-node chat? }
Room : Byte; { Chat room }
End;
(* Chat room record - partially used by the multi node chat functions *)
RoomRec = Record
Name : String[40]; { Channel Name }
Reserved : Array[1..128] of Byte; { RESERVED }
End;
(* CALLERS.DAT holds information on the last ten callers to the BBS. This *)
(* file is always 10 records long with the most recent caller being the *)
(* 10th record. *)
LastOnRec = Record { CALLERS.DAT }
Handle : String[30]; { User's Name }
City : String[25]; { City/State }
Address : String[30]; { user's address }
Baud : String[6]; { Baud Rate }
DateTime : LongInt; { Date & Time (UNIX) }
Node : Byte; { Node number of login }
CallNum : LongInt; { Caller Number }
EmailAddr : String[35]; { email address }
UserInfo : String[30]; { user info field }
Option1 : String[35]; { optional data 1 }
Option2 : String[35]; { " " 2 }
Option3 : String[35]; { " " 3 }
End;
HistoryRec = Record
Date : LongInt;
Emails : Word;
Posts : Word;
Downloads : Word;
Uploads : Word;
DownloadKB : LongInt;
UploadKB : LongInt;
Calls : LongInt;
NewUsers : Word;
End;
RecProtocol = Record
OSType : Byte;
Active : Boolean;
Batch : Boolean;
Key : Char;
Desc : String[40];
SendCmd : String[60];
RecvCmd : String[60];
End;
PromptRec = String[255];
NodeMsgRec = Record
FromNode : Byte;
FromWho : String[30];
ToWho : String[30];
Message : String[250];
MsgType : Byte;
{ 1 = Chat Pub and broadcast }
{ 2 = System message }
{ 3 = User message }
{ 4 = Chat Private }
{ 5 = chat status note }
{ 6 = chat action }
{ 7 = chat topic update }
Room : Byte; { Chat room number. 0 = chat broadcast }
End;