New IO class, internal Zmodem, lots of stuff

This commit is contained in:
mysticbbs 2012-08-11 14:58:58 -04:00
parent dbbd542fa2
commit 3725470afb
23 changed files with 412 additions and 184 deletions

View File

@ -4535,4 +4535,19 @@
+ Restructured some class code to reduce executable sizes in the Mystic
binary. The result is about 120kb smaller executable size in Windows for
Mystic.exe.
Mystic.exe. The other versions should see similar results.
! Mystic was not properly parsing long filenames with spaces in them during
external file transfer.
! Mystic was not properly setting the "Transfering files" node status when
executing transfer protocols.
+ Mystic now has internal Zmodem protocol. To enable it, just use the
@ZMODEM text for the send/receive commands in the Protocol editor, and
Mystic will do the rest. The Zmodem has been tested extensively with:
mTelnet
SyncTerm
SEXYZ
NetRunner

View File

@ -33,7 +33,7 @@ Begin
VerticalLine (22, 7, 13);
Form.AddBol ('A', ' Active ' , 14, 7, 24, 7, 8, 3, @Prot.Active, '');
Form.AddTog ('O', ' OS ' , 18, 8, 24, 8, 4, 7, 0, 2, 'Windows Linux OSX', @Prot.OSType, '');
Form.AddTog ('O', ' OS ' , 18, 8, 24, 8, 4, 7, 0, 3, 'Windows Linux OSX All', @Prot.OSType, '');
Form.AddBol ('B', ' Batch ' , 15, 9, 24, 9, 7, 3, @Prot.Batch, '');
Form.AddChar ('K', ' Hot Key ' , 13, 10, 24, 10, 9, 1, 254, @Prot.Key, '');
Form.AddStr ('D', ' Description ' , 9, 11, 24, 11, 13, 40, 40, @Prot.Desc, '');
@ -71,6 +71,7 @@ Var
0 : OS := 'Windows';
1 : OS := 'Linux ';
2 : OS := 'OSX';
3 : OS := 'All';
End;
//'Active OSID Batch Key Description');

View File

@ -325,6 +325,8 @@ Procedure Configuration_LocalUserEdit;
Var
SavedLocal : Boolean;
Begin
Session.io.BufFlush;
SavedLocal := Session.LocalMode;
Session.InUserEdit := True;

View File

@ -5,6 +5,10 @@ Unit bbs_Common;
Interface
Uses
{$IFDEF WINDOWS}
m_io_Base,
m_io_Sockets,
{$ENDIF}
{$IFDEF UNIX}
Unix,
{$ENDIF}
@ -13,8 +17,7 @@ Uses
m_Output,
m_Input,
m_DateTime,
m_FileIO,
m_Socket_Class;
m_FileIO;
{$I RECORDS.PAS}

View File

@ -5,10 +5,13 @@ Unit BBS_Core;
Interface
Uses
m_io_Base,
{$IFNDEF UNIX}
m_io_Sockets,
{$ENDIF}
m_FileIO,
m_Strings,
m_DateTime,
m_Socket_Class,
BBS_Common,
BBS_IO,
BBS_MsgBase,
@ -22,12 +25,14 @@ Const
Type
TBBSCore = Class
{$IFNDEF UNIX}
Client : TIOBase;
{$ENDIF}
User : TBBSUser;
Msgs : TMsgBase;
FileBase : TFileBase;
Menu : TMenuEngine;
IO : TBBSIO;
Client : TSocketClass;
EventFile : File of EventRec;
ThemeFile : File of RecTheme;
VoteFile : File of VoteRec;
@ -122,9 +127,9 @@ Begin
InMessage := False;
MessageCheck := mysMessageThreshold;
{$IFDEF WINDOWS}
Client := TSocketClass.Create;
Client.FTelnetServer := True;
{$IFNDEF UNIX}
Client := TIOSocket.Create;
TIOSocket(Client).FTelnetServer := True;
{$ENDIF}
User := TBBSUser.Create(Pointer(Self));

View File

@ -11,6 +11,8 @@ Implementation
Uses
{$IFDEF WINDOWS}
Windows,
m_io_Base,
m_io_Sockets,
{$ENDIF}
m_Types,
m_Strings,
@ -218,7 +220,7 @@ Begin
PassHandle := 0;
If Not Session.LocalMode Then
PassHandle := Session.Client.FSocketHandle;
PassHandle := TIOSocket(Session.Client).FSocketHandle;
If Session.User.UserNum <> -1 Then Begin
Reset (Session.User.UserFile);
@ -297,7 +299,7 @@ Begin
{$IFDEF UNIX}
If Cmd[A] = '0' Then Temp := Temp + '1' Else
{$ELSE}
If Cmd[A] = '0' Then Temp := Temp + strI2S(Session.Client.FSocketHandle) Else
If Cmd[A] = '0' Then Temp := Temp + strI2S(TIOSocket(Session.Client).FSocketHandle) Else
{$ENDIF}
If Cmd[A] = '1' Then Temp := Temp + '1' Else
If Cmd[A] = '2' Then Temp := Temp + strI2S(Session.Baud) Else

View File

@ -1,19 +1,31 @@
Unit bbs_FileBase;
{$I M_OPS.PAS}
{$MODESWITCH NESTEDPROCVARS-}
Interface
Uses
m_io_Base,
{$IFDEF WINDOWS}
m_io_Sockets,
{$ENDIF}
{$IFDEF UNIX}
m_io_STDIO,
{$ENDIF}
DOS,
mkCrap,
m_Strings,
m_FileIO,
m_DateTime,
m_Protocol_Queue,
m_Protocol_Base,
m_Protocol_Zmodem,
bbs_Common,
bbs_General,
bbs_NodeInfo,
bbs_Ansi_MenuBox,
AView;
Type
@ -46,7 +58,7 @@ Type
Function DszSearch (FName: String) : Boolean;
Procedure GetTransferTime (Size: Longint; Var Mins : Integer; Var Secs: Byte);
Procedure ExecuteArchive (FName: String; Temp: String; Mask: String; Mode: Byte);
Procedure ExecuteProtocol (Send: Boolean; FName: String);
Procedure ExecuteProtocol (Mode: Byte; FName: String);
Function SelectArchive : Boolean;
Function ListFileAreas (Compress: Boolean) : Integer;
Procedure ChangeFileArea (Data: String);
@ -103,14 +115,11 @@ Begin
Inherited Destroy;
End;
Procedure TFileBase.dszGetFile (Var LogFile: Text; Var FName: String; Var Res: Boolean);
Procedure TFileBase.DszGetFile (Var LogFile: Text; Var FName: String; Var Res: Boolean);
Type
TLineBuf = Array[0..1024] of Char;
Var
LineBuf : TLineBuf;
TempStr1 : DirStr;
TempStr2 : NameStr;
TempStr3 : ExtStr;
WordPos : Integer;
Count : Integer;
Begin
@ -132,6 +141,7 @@ Begin
While WordPos < 11 Do Begin
If LineBuf[Count] = #32 Then Begin
Inc (WordPos);
Repeat
Inc (Count);
Until LineBuf[Count] <> #32;
@ -142,14 +152,17 @@ Begin
Repeat
FName := FName + LineBuf[Count];
Inc (Count);
Until (LineBuf[Count] = #32) or (LineBuf[Count] = #0) or (Count = 1024);
Until (LineBuf[Count] = #0) or (Count = 1024);
FSplit(FName, TempStr1, TempStr2, TempStr3);
While FName[Length(FName)] <> #32 Do
Dec(FName[0]);
FName := TempStr2 + TempStr3;
Dec(FName[0]);
FName := JustFile(FName);
End;
Function TFileBase.dszSearch (FName: String) : Boolean;
Function TFileBase.DszSearch (FName: String) : Boolean;
Var
LogFile : Text;
FileName : String;
@ -159,13 +172,14 @@ Begin
Assign (LogFile, Session.TempPath + 'xfer.log');
{$I-} Reset(LogFile); {$I+}
If IoResult <> 0 Then Begin
Session.SystemLog('ERROR: Can''t find xfer.log');
Exit;
End;
While Not Eof(LogFile) Do Begin
dszGetFile(LogFile, FileName, Status);
DszGetFile(LogFile, FileName, Status);
{$IFDEF FS_SENSITIVE}
If FileName = FName Then Begin
@ -173,6 +187,7 @@ Begin
If strUpper(FileName) = strUpper(FName) Then Begin
{$ENDIF}
Result := Status;
Break;
End;
End;
@ -180,38 +195,168 @@ Begin
Close (LogFile);
End;
Procedure TFileBase.ExecuteProtocol (Send: Boolean; FName: String);
{$IFNDEF UNIX}
Procedure ProtocolStatus (Start, Finish: Boolean; Status: RecProtocolStatus);
Var
T : Text;
Cmd : String;
Count : Byte;
Res : String;
Path : String;
KBRate : LongInt;
Begin
If Send Then
Cmd := Protocol.SendCmd
Else
Cmd := Protocol.RecvCmd;
Screen.WriteXY (19, 10, 113, strPadR(Status.FileName, 56, ' '));
Screen.WriteXY (19, 11, 113, strPadR(strComma(Status.FileSize), 15, ' '));
Screen.WriteXY (19, 12, 113, strPadR(strComma(Status.Position), 15, ' '));
Screen.WriteXY (64, 11, 113, strPadR(strI2S(Status.Errors), 3, ' '));
KBRate := 0;
If (TimerSeconds - Status.StartTime > 0) and (Status.Position > 0) Then
KBRate := Round((Status.Position / (TimerSeconds - Status.StartTime)) / 1024);
Screen.WriteXY (64, 12, 113, strPadR(strI2S(KBRate) + ' k/sec', 12, ' '));
End;
{$ENDIF}
Procedure TFileBase.ExecuteProtocol (Mode: Byte; FName: String);
// mode: 0=recv batch, 1=recv file, 2=send file, 3= send batch
Var
Command : String;
T : Text;
Res : String;
{$IFNDEF UNIX}
Box : TAnsiMenuBox;
SavedL : Boolean;
SavedA : Boolean;
{$ENDIF}
Procedure ExecInternal;
Var
Protocol : TProtocolBase;
Queue : TProtocolQueue;
Count : Word;
Client : TIOBase;
Begin
{$IFDEF UNIX}
Client := TSTDIO.Create;
{$ELSE}
Client := Session.Client;
{$ENDIF}
Command := strStripB(strUpper(Command), ' ');
Queue := TProtocolQueue.Create;
If Command = '@ZMODEM' Then
Protocol := TProtocolZmodem.Create(Client, Queue)
Else Begin
{$IFDEF UNIX}
Client.Free;
{$ENDIF}
Queue.Free;
Exit;
End;
Case Mode of
0,
1 : Protocol.ReceivePath := DirSlash(FName);
2 : Queue.Add(JustPath(FName), JustFile(FName));
3 : Begin
Assign (T, Session.TempPath + 'file.lst');
Reset (T);
While Not Eof(T) Do Begin
ReadLn (T, Res);
Queue.Add(JustPath(Res), JustFile(Res));
End;
Close (T);
End;
End;
Session.io.BufFlush;
{$IFNDEF UNIX}
SavedL := Session.LocalMode;
SavedA := Screen.Active;
Session.LocalMode := True;
Protocol.StatusProc := ProtocolStatus;
Session.io.LocalScreenEnable;
Box := TAnsiMenuBox.Create;
Case Mode of
0..1 : Box.Header := ' ' + Protocol.Status.Protocol + ' Upload ';
2..3 : Box.Header := ' ' + Protocol.Status.Protocol + ' Download ';
End;
Box.Open (6, 8, 76, 14);
Screen.WriteXY ( 8, 10, 112, 'File Name:');
Screen.WriteXY (13, 11, 112, 'Size:');
Screen.WriteXY ( 9, 12, 112, 'Position:');
Screen.WriteXY (56, 11, 112, 'Errors:');
Screen.WriteXY (58, 12, 112, 'Rate:');
{$ENDIF}
Case Mode of
0..1 : Protocol.QueueReceive;
2..3 : Protocol.QueueSend;
End;
{$IFNDEF UNIX}
Box.Free;
Session.io.BufFlush;
If Not SavedA Then
Session.io.LocalScreenDisable;
Session.LocalMode := SavedL;
{$ENDIF}
Assign (T, Session.TempPath + 'xfer.log');
ReWrite (T);
For Count := 1 to Queue.QSize Do Begin
Res[1] := 'E';
If Queue.QData[Count]^.Status = QueueSuccess Then Res[1] := 'Z';
WriteLn(T, Res[1] + ' 0 0 0 0 0 0 0 0 0 ' + Queue.QData[Count]^.FileName + ' -1');
End;
Close (T);
Protocol.Free;
Queue.Free;
{$IFDEF UNIX}
Client.Free;
{$ENDIF}
End;
Procedure ExecExternal;
Var
Path : String;
Count : Byte;
Begin
Res := '';
Path := '';
Count := 1;
While Count <= Length(Cmd) Do Begin
If Cmd[Count] = '%' Then Begin
While Count <= Length(Command) Do Begin
If Command[Count] = '%' Then Begin
Inc(Count);
{$IFNDEF UNIX}
If Cmd[Count] = '0' Then Res := Res + strI2S(Session.Client.FSocketHandle) Else
If Command[Count] = '0' Then Res := Res + strI2S(TIOSocket(Session.Client).FSocketHandle) Else
{$ENDIF}
If Cmd[Count] = '1' Then Res := Res + '1' Else
If Cmd[Count] = '2' Then Res := Res + strI2S(Session.Baud) Else
If Cmd[Count] = '3' Then Res := Res + FName Else
If Cmd[Count] = '4' Then Res := Res + Session.UserIPInfo Else
If Cmd[Count] = '5' Then Res := Res + Session.UserHostInfo Else
If Cmd[Count] = '6' Then Res := Res + strReplace(Session.User.ThisUser.Handle, ' ', '_') Else
If Cmd[Count] = '7' Then Res := Res + strI2S(Session.NodeNum);
If Command[Count] = '1' Then Res := Res + '1' Else
If Command[Count] = '2' Then Res := Res + strI2S(Session.Baud) Else
If Command[Count] = '3' Then Res := Res + FName Else
If Command[Count] = '4' Then Res := Res + Session.UserIPInfo Else
If Command[Count] = '5' Then Res := Res + Session.UserHostInfo Else
If Command[Count] = '6' Then Res := Res + strReplace(Session.User.ThisUser.Handle, ' ', '_') Else
If Command[Count] = '7' Then Res := Res + strI2S(Session.NodeNum);
End Else
Res := Res + Cmd[Count];
Res := Res + Command[Count];
Inc (Count);
End;
@ -230,8 +375,8 @@ Begin
Close (T);
{$ENDIF}
{ If uploading and batch, switch to upload directory via shelldos }
If Not Send And Protocol.Batch Then Path := FName;
// If uploading and batch, switch to upload directory via shelldos
If (Mode < 2) And Protocol.Batch Then Path := FName;
If Res[1] = '!' Then Begin
Delete (Res, 1, 1);
@ -246,6 +391,20 @@ Begin
DirChange (Config.SystemPath);
End;
Begin
Set_Node_Action(Session.GetPrompt(351));
If Mode > 1 Then
Command := Protocol.SendCmd
Else
Command := Protocol.RecvCmd;
If Command[1] = '@' Then
ExecInternal
Else
ExecExternal;
End;
Procedure TFileBase.GetTransferTime (Size: Longint; Var Mins : Integer; Var Secs: Byte);
Var
B : LongInt;
@ -324,6 +483,7 @@ Begin
If FileSize(FScanFile) < Session.User.UserNum - 1 Then Begin
Seek (FScanFile, FileSize(FScanFile));
For A := FileSize(FScanFile) to Session.User.UserNum - 1 Do
Write (FScanFile, Temp);
End;
@ -408,7 +568,7 @@ Begin
If SelectProtocol(True, False) = 'Q' Then Exit;
ExecuteProtocol(True, Data);
ExecuteProtocol(2, Data);
Session.io.OutRawLn ('');
@ -511,6 +671,7 @@ Begin
While Not Eof(FDirFile) Do Begin
Read (FDirFile, FDir);
If (NewFiles and (FDir.DateTime > FScan.LastNew)) or Not NewFiles Then
If FDir.Flags And FDirDeleted = 0 Then Begin
Inc (TotalFiles);
@ -557,7 +718,7 @@ Begin
Session.io.OutFullLn (Session.GetPrompt(225));
Result := (TotalFiles = 0);
Result := (TotalFiles > 0);
If Not Result Then Session.io.OutFullLn(Session.GetPrompt(425));
End;
@ -947,7 +1108,7 @@ Function TFileBase.SelectProtocol (UseDefault, Batch: Boolean) : Char;
While Not Eof(ProtocolFile) Do Begin
Read (ProtocolFile, Protocol);
If ((Protocol.Active) And (Key = Protocol.Key) And (Protocol.Batch = Batch) And (Protocol.OSType = OSType)) Then Begin
If ((Protocol.Active) And (Key = Protocol.Key) And (Protocol.Batch = Batch) And ((Protocol.OSType = OSType) or (Protocol.OSType = 3))) Then Begin
Result := True;
Break;
End;
@ -1528,6 +1689,7 @@ Begin
If Total = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(37));
FBase := Old;
End Else Begin
Repeat
@ -2580,7 +2742,7 @@ Begin
Exit;
End;
ExecuteProtocol(False, FBase.Path);
ExecuteProtocol(0, FBase.Path);
{ ++lang ADD: update node status to transferring file? }
@ -2649,7 +2811,7 @@ Begin
{$IFDEF UNIX}
If Config.TestCmdLine[A] = '0' Then Temp := Temp + '1' Else
{$ELSE}
If Config.TestCmdLine[A] = '0' Then Temp := Temp + strI2S(Session.Client.FSocketHandle) Else
If Config.TestCmdLine[A] = '0' Then Temp := Temp + strI2S(TIOSocket(Session.Client).FSocketHandle) Else
{$ENDIF}
If Config.TestCmdLine[A] = '1' Then Temp := Temp + '1' Else
If Config.TestCmdLine[A] = '2' Then Temp := Temp + '38400' Else
@ -2893,7 +3055,7 @@ Begin
Close (FBaseFile);
Close (FL);
ExecuteProtocol(True, Session.TempPath + 'file.lst');
ExecuteProtocol(3, Session.TempPath + 'file.lst');
Reset (FBaseFile);

View File

@ -8,6 +8,8 @@ Uses
{$IFDEF WINDOWS}
Windows,
WinSock2,
m_io_Base,
m_io_Sockets,
{$ENDIF}
m_Types,
m_DateTime,
@ -943,6 +945,11 @@ Var
Ext := '.asc';
FName := Temp;
Result := True;
End Else
If FileExist(Temp) Then Begin
Ext := '.' + JustFileExt(FName);
FName := Path + JustFileName(FName);
Result := True;
End;
End;
@ -968,7 +975,7 @@ Begin
Result := False;
NoFile := True;
If (Pos(PathSep, FName) > 0) or (Pos('.', FName) > 0) Then Begin
If (Pos(PathSep, FName) > 0) Then Begin
If Not FileExist(FName) Then
If Not CheckFileInPath('') Then Exit;
End Else Begin
@ -979,7 +986,7 @@ Begin
Exit;
End;
If Pos('.', FName) = 0 Then
If (Pos('.', FName) = 0) Then
If FileExist(FName + Copy(Ext, 1, 3) + '1') Then Begin
Repeat
BufPos := Random(9);
@ -1175,7 +1182,7 @@ Begin
Handles[1] := SocketEvent;
WSAResetEvent (Handles[1]);
WSAEventSelect (TBBSCore(Core).Client.FSocketHandle, Handles[1], FD_READ OR FD_CLOSE);
WSAEventSelect (TIOSocket(TBBSCore(Core).Client).FSocketHandle, Handles[1], FD_READ OR FD_CLOSE);
Case WaitForMultipleObjects(2, @Handles, False, Wait) of
WAIT_OBJECT_0 : InType := 1;

View File

@ -596,6 +596,8 @@ Begin
If SpecialKey(Data.Item[Count]^.HotKey) Then Continue;
// check command acs for validkey?
Found := Data.Item[Count]^.HotKey = Temp + UpCase(Ch);
If Not ValidKey Then

View File

@ -1114,7 +1114,7 @@ Begin
If Session.FileBase.SelectProtocol(True, False) = 'Q' Then Exit;
Session.FileBase.ExecuteProtocol(False, FN);
Session.FileBase.ExecuteProtocol(1, FN);
OK := Session.FileBase.dszSearch(JustFile(FN));
End;
@ -3276,7 +3276,7 @@ Begin
Else Begin
If Session.FileBase.SelectProtocol(True, False) = 'Q' Then Exit;
Session.FileBase.ExecuteProtocol(False, Session.TempPath + Config.qwkBBSID + '.rep');
Session.FileBase.ExecuteProtocol(1, Session.TempPath + Config.qwkBBSID + '.rep');
If Not Session.FileBase.dszSearch(Config.qwkBBSID + '.rep') Then Begin
Session.io.PromptInfo[1] := Config.qwkBBSID + '.rep';

View File

@ -248,7 +248,7 @@
132 |01[|10þ|01] |09More: |01(|07Y|01)|09es, |01(|07N|01)|09o, |01(|07C|01)|09ontinueous?
133 |CR|12WARNING: |14System event approaching in |15|NE |14minutes!|CR|PA
134 |CR|12WARNING: You only have |TL minutes remaining!
135 |CR|12Sorry, you have no time left for today.|CR|CR|PA
135 |CR|12Sorry, you have no time left for today.|CR
136 |CR|CR|14Inactivity timeout. Hanging up!
137 |CR|14System Event: Disconnecting.
; Who's online list header
@ -729,9 +729,9 @@
; View text file filename prompt
384 |CR|09File name|CR:
; Download OK &1 = filename
385 |CR|03- Transfer of |11|&1|03: OK
385 |03- Transfer of |11|&1|03: OK
; Download failed &1 = filename
386 |CR|03- Transfer of |11|&1|03: |12Failed!
386 |03- Transfer of |11|&1|03: |12Failed!
; Mass mail prompt
387 |CL|09Send mass mail by|09:|CR|CR|11(|031|08) |09ACS level|CR|11(|032|08)|09 List of users|CR|11(|033|08)|09 All users|CR|11(|03Q|08)|09 Quit|CR|CRCommand |08-> |07
; Mass mail ACS prompt

View File

@ -25,6 +25,7 @@ Program Install;
{$MODESWITCH NESTEDPROCVARS-}
Uses
m_FileIO,
m_Strings,
m_Input,
m_Output,
@ -119,20 +120,23 @@ Begin
IsDir := ((wAttr And Directory) = Directory);
End;
Procedure MakeDir (Str: String);
Function MakeDir (Str: String) : Boolean;
Var
A : Byte;
PathPos : Byte;
CurDIR : String;
Prefix : String;
Begin
Result := True;
If DirExists(Str) Then Exit;
Prefix := '';
PathPos := Pos(PathChar, Str);
A := Pos(PathChar, Str);
While (PathPos > 0) Do Begin
CurDIR := Copy(Str, 1, PathPos);
While (A > 0) Do Begin
CurDIR := Copy(Str, 1, A);
Delete (Str, 1, A);
Delete (Str, 1, PathPos);
Prefix := Prefix + CurDIR;
@ -143,7 +147,7 @@ Begin
End;
End;
A := Pos(PathChar, Str);
PathPos := Pos(PathChar, Str);
End;
End;

View File

@ -36,7 +36,8 @@ Uses
m_Output,
m_Input,
m_DateTime,
m_Socket_Class,
m_io_Base,
m_io_Sockets,
m_FileIO,
m_Strings,
m_Term_Ansi,
@ -264,16 +265,17 @@ Procedure LocalLogin;
Const
BufferSize = 1024 * 4;
Var
Client : TSocketClass;
Client : TIOSocket;
Res : LongInt;
Buffer : Array[1..BufferSize] of Char;
Done : Boolean;
Ch : Char;
Begin
Console.TextAttr := 7;
Console.ClearScreen;
Console.WriteStr ('Connecting to 127.0.0.1... ');
Client := TSocketClass.Create;
Client := TIOSocket.Create;
If Not Client.Connect('127.0.0.1', bbsConfig.InetTNPort) Then
Console.WriteLine('Unable to connect')
@ -284,7 +286,7 @@ Begin
Console.SetWindow (1, 1, 80, 24, True);
Console.WriteXY (1, 25, 112, strPadC('Local TELNET: ALT-X to Quit', 80, ' '));
Term.SetReplyClient(Client);
Term.SetReplyClient(TIOBase(Client));
Repeat
If Client.WaitForData(0) > 0 Then Begin

View File

@ -10,15 +10,16 @@ Interface
Uses
SysUtils,
m_io_Base,
m_io_Sockets,
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;
Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Type
TFTPServer = Class(TServerClient)
@ -33,7 +34,7 @@ Type
Data : String;
DataPort : Word;
DataIP : String;
DataSocket : TSocketClass;
DataSocket : TIOSocket;
User : RecUser;
UserPos : LongInt;
FBasePos : LongInt;
@ -41,7 +42,7 @@ Type
SecLevel : RecSecurity;
FileMask : String;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
@ -101,12 +102,12 @@ Const
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;
Function CreateFTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TFTPServer.Create(Owner, CliSock);
End;
Constructor TFTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor TFTPServer.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);
@ -245,7 +246,7 @@ End;
Function TFTPServer.OpenDataSession : Boolean;
Var
WaitSock : TSocketClass;
WaitSock : TIOSocket;
Begin
Result := False;
@ -258,7 +259,7 @@ Begin
Client.WriteLine(re_DataOpening);
If IsPassive Then Begin
WaitSock := TSocketClass.Create;
WaitSock := TIOSocket.Create;
WaitSock.WaitInit(DataPort);
@ -272,7 +273,7 @@ Begin
WaitSock.Free;
End Else Begin
DataSocket := TSocketClass.Create;
DataSocket := TIOSocket.Create;
If Not DataSocket.Connect(DataIP, DataPort) Then Begin
Client.WriteLine(re_NoData);
@ -415,7 +416,7 @@ End;
Procedure TFTPServer.cmdPASV;
Var
WaitSock : TSocketClass;
WaitSock : TIOSocket;
Begin
If LoggedIn Then Begin
DataPort := Random(bbsConfig.inetFTPPortMax - bbsConfig.inetFTPPortMin) + bbsConfig.inetFTPPortMin;
@ -424,7 +425,7 @@ Begin
IsPassive := True;
WaitSock := TSocketClass.Create;
WaitSock := TIOSocket.Create;
WaitSock.WaitInit(DataPort);
@ -708,7 +709,7 @@ End;
Procedure TFTPServer.cmdEPSV;
Var
WaitSock : TSocketClass;
WaitSock : TIOSocket;
Begin
If LoggedIn Then Begin
If Data = '' Then Begin
@ -717,7 +718,7 @@ Begin
Client.WriteLine('229 Entering Extended Passive Mode (|||' + strI2S(DataPort) + '|)');
WaitSock := TSocketClass.Create;
WaitSock := TIOSocket.Create;
WaitSock.WaitInit(DataPort);

View File

@ -8,15 +8,16 @@ Interface
Uses
SysUtils,
m_io_Base,
m_io_Sockets,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
MIS_Common;
Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Type
TNNTPServer = Class(TServerClient)
@ -32,7 +33,7 @@ Type
CurArticle : LongInt;
EndSession : Boolean;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
@ -70,12 +71,12 @@ Const
re_Unknown = '500 Unknown command';
re_UnknownOption = '501 Unknown option';
Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TNNTPServer.Create(Owner, CliSock);
End;
Constructor TNNTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor TNNTPServer.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);

View File

@ -12,9 +12,10 @@ Uses
MD5,
Classes,
SysUtils,
m_io_Base,
m_io_Sockets,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
MIS_Server,
MIS_NodeData,
@ -23,7 +24,7 @@ Uses
BBS_MsgBase_JAM,
BBS_MsgBase_Squish;
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Const
MaxMailBoxSize = 1000;
@ -50,7 +51,7 @@ Type
MailInfo : Array[1..MaxMailBoxSize] of PMailMessageRec;
MailSize : LongInt;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
@ -91,12 +92,12 @@ Const
re_ResetOK = re_OK + 'Messages reset';
re_MsgDeleted = re_OK + 'Message deleted';
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreatePOP3 (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TPOP3Server.Create(Owner, CliSock);
End;
Constructor TPOP3Server.Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor TPOP3Server.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);

View File

@ -10,9 +10,10 @@ Interface
Uses
Classes,
SysUtils,
m_io_Base,
m_io_Sockets,
m_Strings,
m_FileIO,
m_Socket_Class,
m_DateTime,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
@ -21,7 +22,7 @@ Uses
MIS_NodeData,
MIS_Common;
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Type
TSMTPServer = Class(TServerClient)
@ -35,7 +36,7 @@ Type
FromPos : LongInt;
ToList : TStringList;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
@ -62,12 +63,12 @@ Const
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;
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TSMTPServer.Create(Owner, CliSock);
End;
Constructor TSMTPServer.Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor TSMTPServer.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);

View File

@ -15,32 +15,33 @@ Uses
{$IFDEF WINDOWS}
Windows,
{$ENDIF}
m_io_Base,
m_io_Sockets,
m_Strings,
m_Socket_Class,
MIS_Common,
MIS_NodeData,
MIS_Server;
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
{ must match server create or there will be access violations }
Type
TTelnetServer = Class(TServerClient)
ND : TNodeData;
Snooping : Boolean;
Constructor Create (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; ND: TNodeData; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
End;
Implementation
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TSocketClass) : TServerClient;
Function CreateTelnet (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TTelnetServer.Create(Owner, ND, CliSock);
End;
Constructor TTelnetServer.Create (Owner: TServerManager; ND: TNodeData; CliSock: TSocketClass);
Constructor TTelnetServer.Create (Owner: TServerManager; ND: TNodeData; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);

View File

@ -6,7 +6,8 @@ Interface
Uses
Classes,
m_Socket_Class,
m_io_Base,
m_io_Sockets,
MIS_Common,
MIS_NodeData;
@ -16,12 +17,12 @@ Const
Type
TServerManager = Class;
TServerClient = Class;
TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TSocketClass): TServerClient;
TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TIOSocket): TServerClient;
TServerManager = Class(TThread)
Critical : TRTLCriticalSection;
NodeInfo : TNodeData;
Server : TSocketClass;
Server : TIOSocket;
ServerStatus : TStringList;
StatusUpdated : Boolean;
ClientList : TList;
@ -41,15 +42,15 @@ Type
Procedure Execute; Override;
Procedure Status (Str: String);
Function CheckIP (IP, Mask: String) : Boolean;
Function IsBlockedIP (Var Client: TSocketClass) : Boolean;
Function DuplicateIPs (Var Client: TSocketClass) : Byte;
Function IsBlockedIP (Var Client: TIOSocket) : Boolean;
Function DuplicateIPs (Var Client: TIOSocket) : Byte;
End;
TServerClient = Class(TThread)
Client : TSocketClass;
Client : TIOSocket;
Manager : TServerManager;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Destructor Destroy; Override;
End;
@ -75,7 +76,7 @@ Begin
ClientActive := 0;
ClientMaxIPs := 1;
NewClientProc := CreateProc;
Server := TSocketClass.Create;
Server := TIOSocket.Create;
ServerStatus := TStringList.Create;
StatusUpdated := False;
ClientList := TList.Create;
@ -122,7 +123,7 @@ Begin
End;
End;
Function TServerManager.IsBlockedIP (Var Client: TSocketClass) : Boolean;
Function TServerManager.IsBlockedIP (Var Client: TIOSocket) : Boolean;
Var
TF : Text;
Str : String;
@ -146,17 +147,27 @@ Begin
End;
End;
Function TServerManager.DuplicateIPs (Var Client: TSocketClass) : Byte;
Function TServerManager.DuplicateIPs (Var Client: TIOSocket) : 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
If Client.PeerIP = TIOSocket(ClientList[Count]).PeerIP Then
Inc(Result);*)
For Count := 0 to ClientMax - 1 Do
If Assigned(ClientList[Count]) Then Begin
// writeln('client ip:', client.peerip);
// writeln('comp ip :', TIOSocket(clientlist[count]).fpeerip);
// waitms(3000);
If Client.PeerIP = TIOSocket(ClientList[Count]).PeerIP Then
Inc(Result);
End;
End;
Procedure TServerManager.Status (Str: String);
Var
@ -193,7 +204,7 @@ End;
Procedure TServerManager.Execute;
Var
NewClient : TSocketClass;
NewClient : TIOSocket;
Begin
Repeat Until Server <> NIL; // Synchronize with server class
Repeat Until ServerStatus <> NIL; // Syncronize with status class
@ -224,7 +235,7 @@ Begin
If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED');
NewClient.Free;
End Else
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) >= ClientMaxIPs) Then Begin
Inc (ClientRefused);
Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user');
@ -273,7 +284,7 @@ Begin
Inherited Destroy;
End;
Constructor TServerClient.Create (Owner: TServerManager; CliSock: TSocketClass);
Constructor TServerClient.Create (Owner: TServerManager; CliSock: TIOSocket);
Var
Count : Byte;
Begin

View File

@ -43,9 +43,11 @@ 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;
@ -115,13 +117,10 @@ Function SaveFile(FN: String; Var Rec; FS: Word): Word;
Procedure Str2Az(Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
Begin
If Length(Str) >= MaxLen Then
Begin
If Length(Str) >= MaxLen Then Begin
Str[MaxLen] := #0;
Move(Str[1], AZStr, MaxLen);
End
Else
Begin
End Else Begin
Str[Length(Str) + 1] := #0;
Move(Str[1], AZStr, Length(Str) + 1);
End;
@ -147,7 +146,6 @@ Begin
End;
End;
Function FormattedDate(DT: DateTime; Mask: String): String;
Var
DStr : String[2];

View File

@ -28,6 +28,10 @@ Uses
HeapTrc,
LineInfo,
{$ENDIF}
{$IFDEF WINDOWS}
m_io_Base,
m_io_Sockets,
{$ENDIF}
{$IFDEF UNIX}
BaseUnix,
{$ENDIF}
@ -411,7 +415,7 @@ Begin
Session.LocalMode := Session.CommHandle = -1;
If Not Session.LocalMode Then Begin
Session.Client.FSocketHandle := Session.CommHandle;
TIOSocket(Session.Client).FSocketHandle := Session.CommHandle;
Session.io.LocalScreenDisable;
End;

View File

@ -19,10 +19,15 @@ BUGS AND POSSIBLE ISSUES
FPC BUG? DirAttr is suspect in MPL is it 1 byte or 4 in size?
! View archive not working if its external view? [Griffin]
! Message header does not ackknowledge user's date format.
! Test MIS blocking features or just rewrite MIS completely.
! AllFiles/NewFiles not properly prompting to zip and download.
! Check multiple BBS list functionality.
FUTURE / IDEAS / WORK IN PROGRESS / NOTES
=========================================
- BBS email autoforwarded to Internet email
- Ability to send internet email to people from within the BBS.
- ANSI post-processor for message uploads via FSE
- ANSI reading support in fullscreen reader
- Ability to override read-type per message base (usersetting/normal/lightbar)