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

BinkP work

This commit is contained in:
mysticbbs 2013-03-24 05:45:47 -04:00
parent 76e9dcc96e
commit 6f4f9bb2cd
2 changed files with 237 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

248
mdl/m_prot_binkp.pas
View File

@ -1,14 +1,19 @@
Program BT; Program BinkPoll;
{$I M_OPS.PAS} {$I M_OPS.PAS}
Uses Uses
cryptoldold, DOS,
CryptNew,
m_DateTime, m_DateTime,
m_FileIO, m_FileIO,
m_Strings, m_Strings,
m_IO_Sockets, m_IO_Sockets,
m_Protocol_Queue; m_Protocol_Queue,
bbs_Common;
Var
bbsConfig : RecConfig;
Const Const
M_NUL = 0; M_NUL = 0;
@ -25,12 +30,8 @@ Const
M_DATA = 255; M_DATA = 255;
BinkPMaxBufferSize = 30 * 1024; BinkPMaxBufferSize = 30 * 1024;
BinkPTimeOut = 3000;
BinkPUseCRAMMD5 = True;
TempFileTime = 1363944820; TempFileTime = 1363944820;
InboundPath : String = 'd:\dev\code\mystic\dls\';
Const Const
BinkCmdStr : Array[0..10] of String[4] = ( BinkCmdStr : Array[0..10] of String[4] = (
'NUL ', 'NUL ',
@ -80,9 +81,14 @@ Type
); );
TBinkP = Class TBinkP = Class
SetPassword : String;
SetBlockSize : Word;
SetTimeOut : Word;
Client : TIOSocket; Client : TIOSocket;
IsClient : Boolean; IsClient : Boolean;
UseMD5 : Boolean; UseMD5 : Boolean;
ForceMD5 : Boolean;
AuthState : TBinkAuthState; AuthState : TBinkAuthState;
TimeOut : LongInt; TimeOut : LongInt;
TxState : TBinkTxState; TxState : TBinkTxState;
@ -96,7 +102,7 @@ Type
MD5Challenge : String; MD5Challenge : String;
FileList : TProtocolQueue; FileList : TProtocolQueue;
Constructor Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli, MD5: Boolean); Constructor Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli: Boolean; TOV: Word);
Destructor Destroy; Override; Destructor Destroy; Override;
Function GetDataStr : String; Function GetDataStr : String;
@ -124,18 +130,20 @@ Begin
End; End;
End; End;
Constructor TBinkP.Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli, MD5: Boolean); Constructor TBinkP.Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli: Boolean; TOV: Word);
Begin Begin
Inherited Create; Inherited Create;
SetTimeOut := TOV;
Client := C; Client := C;
FileList := FL; FileList := FL;
IsClient := IsCli; IsClient := IsCli;
UseMD5 := MD5; UseMD5 := False;
ForceMD5 := False;
RxBufSize := 0; RxBufSize := 0;
RxState := RxNone; RxState := RxNone;
TxState := TxNone; TxState := TxNone;
TimeOut := TimerSet(BinkPTimeout); TimeOut := TimerSet(SetTimeout);
NeedHeader := True; NeedHeader := True;
HaveHeader := False; HaveHeader := False;
MD5Challenge := ''; MD5Challenge := '';
@ -173,7 +181,8 @@ Begin
Client.BufWriteStr(Char(Hi(DataSize)) + Char(Lo(DataSize)) + Char(CmdType) + CmdData + #0); Client.BufWriteStr(Char(Hi(DataSize)) + Char(Lo(DataSize)) + Char(CmdType) + CmdData + #0);
Client.BufFlush; Client.BufFlush;
WriteLn ('Put Command Frame (', BinkCmdStr[CmdType], ') Data: ', CmdData); WriteLn (' S ' + BinkCmdStr[CmdType] + ' ' + CmdData);
//WriteLn ('Put Command Frame (', BinkCmdStr[CmdType], ') Data: ', CmdData);
End; End;
Procedure TBinkP.SendDataFrame (Var Buf; BufSize: Word); Procedure TBinkP.SendDataFrame (Var Buf; BufSize: Word);
@ -191,7 +200,7 @@ Begin
Client.WriteBuf (LoChar, 1); Client.WriteBuf (LoChar, 1);
Client.WriteBuf (SendData[1], BufSize); Client.WriteBuf (SendData[1], BufSize);
TimeOut := TimerSet(BinkPTimeOut); TimeOut := TimerSet(SetTimeOut);
// WriteLn ('Put Data Frame (', BufSize, ')'); // WriteLn ('Put Data Frame (', BufSize, ')');
End; End;
@ -223,13 +232,15 @@ Begin
Client.ReadBuf(RxBuffer[InPos], 1); Client.ReadBuf(RxBuffer[InPos], 1);
If Client.Connected Then Begin If Client.Connected Then Begin
TimeOut := TimerSet(BinkPTimeOut); TimeOut := TimerSet(SetTimeOut);
NeedHeader := False; NeedHeader := False;
HaveHeader := True; HaveHeader := True;
End; End;
Case RxFrameType of Case RxFrameType of
Command : WriteLn ('Got Command Frame (', BinkCmdStr[RxCommand], ') Data: ', GetDataStr); // Command : If (RxCommand = M_NUL) or (RxCommand = M_ERR) Then
// WriteLn (' R ', BinkCmdStr[RxCommand], ' ', GetDataStr);
Command : WriteLn (' R ', BinkCmdStr[RxCommand], ' ', GetDataStr);
// Data : WriteLn ('Got Data Frame (Read ', InPos, ' of ', RxBufSize, ')'); // Data : WriteLn ('Got Data Frame (Read ', InPos, ' of ', RxBufSize, ')');
End; End;
End; End;
@ -240,7 +251,7 @@ Var
Str : String; Str : String;
Count : LongInt; Count : LongInt;
Begin Begin
WriteLn ('Begin Authentication'); //WriteLn ('Begin Authentication');
Repeat Repeat
DoFrameCheck; DoFrameCheck;
@ -268,10 +279,10 @@ Begin
SendChallenge : Begin // Send MD5 digest SendChallenge : Begin // Send MD5 digest
End; End;
SendWelcome : Begin SendWelcome : Begin
SendFrame (M_NUL, 'SYS Sector7'); SendFrame (M_NUL, 'SYS ' + bbsConfig.BBSName);
SendFrame (M_NUL, 'ZYZ g00r00'); SendFrame (M_NUL, 'ZYZ ' + bbsConfig.SysopName);
SendFrame (M_NUL, 'LOC Philadelphia, PA'); // SendFrame (M_NUL, 'LOC Philadelphia, PA');
SendFrame (M_NUL, 'VER Mystic/1.10 binkp/1.1'); SendFrame (M_NUL, 'VER Mystic/1.10 binkp/1.0');
If IsClient Then If IsClient Then
AuthState := SendAddress AuthState := SendAddress
@ -280,25 +291,41 @@ Begin
End; End;
SendAddress : Begin SendAddress : Begin
SendFrame (M_ADR, '55:268/212@mysticnet'); Str := '';
For Count := 1 to 30 Do
If strAddr2Str(bbsConfig.NetAddress[Count]) <> '0:0/0' Then Begin
If Str <> '' Then Str := Str + ' ';
Str := Str + strAddr2Str(bbsConfig.NetAddress[Count]);
If bbsConfig.NetDomain[Count] <> '' Then
Str := Str + '@' + bbsConfig.NetDomain[Count];
End;
SendFrame (M_ADR, Str);
AuthState := SendPassword; AuthState := SendPassword;
End; End;
SendPassword : If HaveHeader Then Begin // wait for header to see if we support CRAMMD5 SendPassword : If HaveHeader Then Begin // wait for header to see if we support CRAMMD5
If UseMD5 And (MD5Challenge <> '') Then Begin If UseMD5 And (MD5Challenge <> '') Then Begin
Str := 'password'; MD5Challenge := Digest2String(HMAC_MD5(String2Digest(MD5Challenge), SetPassword));
MD5Challenge := StrHex(MD5Challenge);
MD5Challenge := HexStr(HMAC_MD5(Str, MD5Challenge));
SendFrame (M_PWD, 'CRAM-MD5-' + MD5Challenge); SendFrame (M_PWD, 'CRAM-MD5-' + MD5Challenge);
End Else End Else
// if forced CRAMMD5 then error and exit otherwise... If ForceMD5 Then Begin
SendFrame (M_PWD, 'password'); SendFrame (M_ERR, 'Required CRAM-MD5 authentication');
AuthState := AuthFailed;
End Else
SendFrame (M_PWD, SetPassword);
Client.BufFlush; Client.BufFlush;
HaveHeader := False; HaveHeader := False;
NeedHeader := True; NeedHeader := True;
If AuthState <> AuthFailed Then
AuthState := WaitPwdOK; AuthState := WaitPwdOK;
End; End;
WaitAddress : Begin WaitAddress : Begin
@ -331,11 +358,11 @@ Var
InTime : Cardinal; InTime : Cardinal;
FSize : Cardinal; FSize : Cardinal;
Begin Begin
WriteLn ('Begin File Transfers'); //WriteLn ('Begin File Transfers');
RxState := RxWaitFile; RxState := RxWaitFile;
TxState := TxNextFile; TxState := TxNextFile;
TimeOut := TimerSet(BinkPTimeOut); TimeOut := TimerSet(SetTimeOut);
NeedHeader := True; NeedHeader := True;
HaveHeader := False; HaveHeader := False;
@ -369,8 +396,8 @@ Begin
InTime := strS2I(strWordGet(3, Str, ' ')); InTime := strS2I(strWordGet(3, Str, ' '));
InPos := strS2I(strWordGet(4, Str, ' ')); InPos := strS2I(strWordGet(4, Str, ' '));
If FileExist(InBoundPath + InFN) Then Begin If FileExist(bbsConfig.InBoundPath + InFN) Then Begin
FSize := FileByteSize(InBoundPath + InFN); FSize := FileByteSize(bbsConfig.InBoundPath + InFN);
// fix timestamp and escape filen // fix timestamp and escape filen
@ -385,7 +412,7 @@ Begin
End; End;
End; End;
Assign (InFile, InBoundPath + InFN); Assign (InFile, bbsConfig.InBoundPath + InFN);
Reset (InFile, 1); Reset (InFile, 1);
If IoResult <> 0 Then ReWrite (InFile, 1); If IoResult <> 0 Then ReWrite (InFile, 1);
@ -477,29 +504,172 @@ Begin
If Client.Connected Then Client.BufFlush; If Client.Connected Then Client.BufFlush;
End; End;
Procedure PollNode (Var Queue: TProtocolQueue; Var EchoNode: RecEchoMailNode);
Var Var
BinkP : TBinkP; BinkP : TBinkP;
Client : TIOSocket; Client : TIOSocket;
Queue : TProtocolQueue; Port : Word;
Begin Begin
Queue := TProtocolQueue.Create;
Client := TIOSocket.Create; Client := TIOSocket.Create;
Client.FTelnetClient := False; Client.FTelnetClient := False;
Client.FTelnetServer := False; Client.FTelnetServer := False;
Queue.Add('d:\s7\echomail\inbound\t\', '0019ff33.mo0'); Write ('- Connecting to ', EchoNode.binkHost, ': ');
Queue.Add('d:\s7\echomail\inbound\t\', '0019ff33.mo1');
Queue.Add('d:\s7\echomail\inbound\t\', '0019ff33.mo2');
BinkP := TBinkP.Create(Client, Queue, True, False); Port := strS2I(strWordGet(2, EchoNode.binkHost, ':'));
Client.Connect ('localhost', 24554); If Port = 0 Then Port := 24554;
If Not Client.Connect (strWordGet(1, EchoNode.binkHost, ':'), Port) Then Begin
WriteLn ('UNABLE TO CONNECT');
Client.Free;
Exit;
End;
WriteLn ('CONNECTED!');
BinkP := TBinkP.Create(Client, Queue, True, EchoNode.binkTimeOut * 100);
BinkP.SetPassword := EchoNode.binkPass;
BinkP.SetBlockSize := EchoNode.binkBlock;
BinkP.UseMD5 := EchoNode.binkMD5 > 0;
BinkP.ForceMD5 := EchoNode.binkMD5 = 2;
If BinkP.DoAuthentication Then If BinkP.DoAuthentication Then
BinkP.DoTransfers; BinkP.DoTransfers
Else
WriteLn ('- Unable to authenticate');
BinkP.Free; BinkP.Free;
Client.Free; Client.Free;
End;
Function GetFTNFlowName (Dest: RecEchoMailAddr) : String;
Begin
Result := strI2H((Dest.Net SHL 16) OR Dest.Node);
End;
Procedure ScanOutbound;
Var
DirInfo : SearchRec;
FLOFile : Text;
EchoFile : File of RecEchoMailNode;
EchoNode : RecEchoMailNode;
Queue : TProtocolQueue;
Str : String;
FN : String;
Path : String;
Matched : Boolean;
Begin
WriteLn ('Scanning configured Echomail nodes...');
WriteLn;
FindFirst (bbsConfig.OutboundPath + '*.?lo', AnyFile, DirInfo);
While DosError = 0 Do Begin
Write ('- Found ', DirInfo.Name, ' -> Send Type: ');
Case UpCase(JustFileExt(DirInfo.Name)[1]) of
'C' : WriteLn ('Crash');
'D' : WriteLn ('Direct');
'H' : Begin
WriteLn ('Hold - SKIPPING');
FindNext (DirInfo);
Continue;
End;
Else
WriteLn ('Normal');
End;
Matched := False;
Assign (EchoFile, bbsConfig.DataPath + 'echonode.dat');
{$I-} Reset (EchoFile); {$I+}
If IoResult <> 0 Then Begin
WriteLn ('- Unable to match .FLO with configured Echomail node');
FindNext (DirInfo);
Continue;
End;
While Not Eof(EchoFile) And Not Matched Do Begin
Read (EchoFile, EchoNode);
Matched := (strUpper(JustFileName(DirInfo.Name)) = strUpper(GetFTNFlowName(EchoNode.Address))) and EchoNode.Active and (EchoNode.ProtType = 0);
End;
Close (EchoFile);
If Not Matched Then Begin
WriteLn ('- Unable to match .FLO with configured Echomail node');
FindNext (DirInfo);
Continue;
End;
Queue := TProtocolQueue.Create;
Assign (FLOFile, bbsConfig.OutboundPath + DirInfo.Name);
Reset (FLOFile);
While Not Eof(FLOFile) Do Begin
ReadLn (FLOFile, Str);
If (Str = '') or (Str[1] = '!') Then Continue;
Str := strStripB(Copy(Str, 2, 255), ' ');
FN := JustFile(Str);
Path := JustPath(Str);
Queue.Add (Path, FN);
End;
Close (FLOFile);
WriteLn('- Queued ', Queue.QSize, ' files (', Queue.QFSize, ' bytes) to ', strAddr2Str(EchoNode.Address));
If Queue.QSize > 0 Then
PollNode(Queue, Echonode);
Queue.Free; Queue.Free;
FindNext (DirInfo);
End;
FindClose (DirInfo);
End;
Var
CF : File of RecConfig;
Begin
WriteLn;
WriteLn ('BINKPOLL Version ' + mysVersion);
WriteLn;
Assign (CF, '\s7\mystic.dat');
{$I-} Reset(CF); {$I+}
If IoResult <> 0 Then Begin
WriteLn ('Unable to read MYSTIC.DAT');
Halt(1);
End;
Read (CF, bbsConfig);
Close (CF);
If bbsConfig.DataChanged <> mysDataChanged Then Begin
WriteLn ('Mystic VERSION mismatch');
Halt(1);
End;
ScanOutbound;
End. End.

24
mdl/m_protocol_queue.pas
View File

@ -25,6 +25,7 @@ Type
End; End;
TProtocolQueue = Class TProtocolQueue = Class
QFSize : Cardinal;
QSize : Word; QSize : Word;
QPos : Word; QPos : Word;
QData : Array[1..QueueMaxSize] of TProtocolQueuePTR; QData : Array[1..QueueMaxSize] of TProtocolQueuePTR;
@ -44,6 +45,7 @@ Constructor TProtocolQueue.Create;
Begin Begin
Inherited Create; Inherited Create;
QFSize := 0;
QSize := 0; QSize := 0;
QPos := 0; QPos := 0;
End; End;
@ -57,7 +59,7 @@ Function TProtocolQueue.Add (fPath, fName: String) : Boolean;
Var Var
F : File; F : File;
Begin Begin
Add := False; Result := False;
If (QSize = QueueMaxSize) Then Exit; If (QSize = QueueMaxSize) Then Exit;
@ -76,11 +78,20 @@ Begin
If IoResult = 0 Then Begin If IoResult = 0 Then Begin
QData[QSize]^.FileSize := FileSize(F); QData[QSize]^.FileSize := FileSize(F);
QData[QSize]^.Status := QueuePending; QData[QSize]^.Status := QueuePending;
Close(F);
End Else
QData[QSize]^.Status := QueueNoFile;
Add := True; Inc (QFSize, QData[QSize]^.FileSize);
Close(F);
End Else Begin
Dispose (QData[QSize]);
Dec (QSize);
Exit;
// QData[QSize]^.Status := QueueNoFile;
End;
Result := True;
End; End;
Procedure TProtocolQueue.Delete (Idx: Word); Procedure TProtocolQueue.Delete (Idx: Word);
@ -88,6 +99,8 @@ Var
Count : Word; Count : Word;
Begin Begin
If QData[Idx] <> NIL Then Begin If QData[Idx] <> NIL Then Begin
Dec (QFSize, QData[QSize]^.FileSize);
Dispose (QData[Idx]); Dispose (QData[Idx]);
For Count := Idx To QueueMaxSize - 1 Do For Count := Idx To QueueMaxSize - 1 Do
@ -123,6 +136,7 @@ Begin
QData[Count] := NIL; QData[Count] := NIL;
End; End;
QFSize := 0;
QSize := 0; QSize := 0;
QPos := 0; QPos := 0;
End; End;