diff --git a/mdl/m_prot_binkp.pas b/mdl/m_prot_binkp.pas new file mode 100644 index 0000000..63d6be0 --- /dev/null +++ b/mdl/m_prot_binkp.pas @@ -0,0 +1,505 @@ +Program BT; + +{$I M_OPS.PAS} + +Uses + cryptoldold, + m_DateTime, + m_FileIO, + m_Strings, + m_IO_Sockets, + m_Protocol_Queue; + +Const + M_NUL = 0; + M_ADR = 1; + M_PWD = 2; + M_FILE = 3; + M_OK = 4; + M_EOB = 5; + M_GOT = 6; + M_ERR = 7; + M_BSY = 8; + M_GET = 9; + M_SKIP = 10; + M_DATA = 255; + + BinkPMaxBufferSize = 30 * 1024; + BinkPTimeOut = 3000; + BinkPUseCRAMMD5 = True; + TempFileTime = 1363944820; + + InboundPath : String = 'd:\dev\code\mystic\dls\'; + +Const + BinkCmdStr : Array[0..10] of String[4] = ( + 'NUL ', + 'ADR ', + 'PWD ', + 'FILE', + 'OK ', + 'EOB ', + 'GOT ', + 'ERR ', + 'BSY ', + 'GET ', + 'SKIP' + ); + +Type + TBinkAuthState = ( + SendChallenge, + SendWelcome, + SendAddress, + SendPassword, + WaitAddress, + WaitPassword, + WaitPwdOK, + AuthOK, + AuthFailed + ); + + TBinkRxState = ( + RxNone, + RxWaitFile, + RxGetData, + RxDone + ); + + TBinkTxState = ( + TxNone, + TxNextFile, + TxSendData, + TxGetEOF, + TxDone + ); + + TBinkFrameType = ( + Command, + Data + ); + + TBinkP = Class + Client : TIOSocket; + IsClient : Boolean; + UseMD5 : Boolean; + AuthState : TBinkAuthState; + TimeOut : LongInt; + TxState : TBinkTxState; + RxState : TBinkRxState; + RxFrameType : TBinkFrameType; + RxCommand : Byte; + RxBuffer : Array[1..BinkPMaxBufferSize] of Char; + RxBufSize : LongInt; + HaveHeader : Boolean; + NeedHeader : Boolean; + MD5Challenge : String; + FileList : TProtocolQueue; + + Constructor Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli, MD5: Boolean); + Destructor Destroy; Override; + + Function GetDataStr : String; + Procedure SendFrame (CmdType: Byte; CmdData: String); + Procedure SendDataFrame (Var Buf; BufSize: Word); + Procedure DoFrameCheck; + Function DoAuthentication : Boolean; + Procedure DoTransfers; + End; + +Function GetStateStr (S: TBinkAuthState) : String; +Begin + Case S of + SendChallenge : Result := 'SendChallenge'; + SendWelcome : Result := 'SendWelcome'; + SendAddress : Result := 'SendAddress'; + SendPassword : Result := 'SendPassword'; + WaitAddress : Result := 'WaitAddress'; + WaitPassword : Result := 'WaitPassword'; + WaitPwdOK : Result := 'WaitPwdOK'; + AuthOK : Result := 'AuthOK'; + AuthFailed : Result := 'AuthFailed'; + Else + Result := 'Unknown'; + End; +End; + +Constructor TBinkP.Create (Var C: TIOSocket; Var FL: TProtocolQueue; IsCli, MD5: Boolean); +Begin + Inherited Create; + + Client := C; + FileList := FL; + IsClient := IsCli; + UseMD5 := MD5; + RxBufSize := 0; + RxState := RxNone; + TxState := TxNone; + TimeOut := TimerSet(BinkPTimeout); + NeedHeader := True; + HaveHeader := False; + MD5Challenge := ''; + AuthState := SendWelcome; + + If Not IsClient and UseMD5 Then + AuthState := SendChallenge; +End; + +Destructor TBinkP.Destroy; +Begin + Inherited Destroy; +End; + +Function TBinkP.GetDataStr : String; +Var + SZ : Byte; +Begin + If RxBufSize > 255 Then + SZ := 255 + Else + SZ := RxBufSize; + + Move (RxBuffer[1], Result[1], SZ); + + Result[0] := Char(SZ); +End; + +Procedure TBinkP.SendFrame (CmdType: Byte; CmdData: String); +Var + DataSize : Word; +Begin + DataSize := (Length(CmdData) + 2) OR $8000; + + Client.BufWriteStr(Char(Hi(DataSize)) + Char(Lo(DataSize)) + Char(CmdType) + CmdData + #0); + Client.BufFlush; + + WriteLn ('Put Command Frame (', BinkCmdStr[CmdType], ') Data: ', CmdData); +End; + +Procedure TBinkP.SendDataFrame (Var Buf; BufSize: Word); +Var + SendData : Array[1.. BinkPMaxBufferSize] of Char Absolute Buf; + HiChar : Char; + LoChar : Char; +Begin + HiChar := Char(Hi(BufSize)); + LoChar := Char(Lo(BufSize)); + + Client.BufFlush; + + Client.WriteBuf (HiChar, 1); + Client.WriteBuf (LoChar, 1); + Client.WriteBuf (SendData[1], BufSize); + + TimeOut := TimerSet(BinkPTimeOut); + +// WriteLn ('Put Data Frame (', BufSize, ')'); +End; + +Procedure TBinkP.DoFrameCheck; +Var + CharHi : Char; + CharLo : Char; + InPos : LongInt; +Begin + If NeedHeader And Not HaveHeader And Client.DataWaiting Then Begin + Client.ReadBuf (CharHi, 1); + Client.ReadBuf (CharLo, 1); + + RxBufSize := (Word(CharHi) SHL 8) + Word(CharLo); + + If Byte(CharHi) AND $80 = 0 Then Begin + RxCommand := M_DATA; + RxFrameType := Data; + End Else Begin + RxBufSize := (RxBufSize AND ($8000 - 1)) - 1; + RxFrameType := Command; + + Client.ReadBuf (RxCommand, 1); + End; + + If RxBufSize > 0 Then + For InPos := 1 to RxBufSize Do + Client.ReadBuf(RxBuffer[InPos], 1); + + If Client.Connected Then Begin + TimeOut := TimerSet(BinkPTimeOut); + NeedHeader := False; + HaveHeader := True; + End; + + Case RxFrameType of + Command : WriteLn ('Got Command Frame (', BinkCmdStr[RxCommand], ') Data: ', GetDataStr); +// Data : WriteLn ('Got Data Frame (Read ', InPos, ' of ', RxBufSize, ')'); + End; + End; +End; + +Function TBinkP.DoAuthentication; +Var + Str : String; + Count : LongInt; +Begin + WriteLn ('Begin Authentication'); + + Repeat + DoFrameCheck; + + If Not Client.Connected or (TimerUp(TimeOut)) Then + AuthState := AuthFailed + Else + If HaveHeader and (RxCommand = M_NUL) Then Begin + // Eat MNUL and get another header but steal MD5 challenge + // and anything else we want to parse from OPTs, etc + + NeedHeader := True; + HaveHeader := False; + + Str := GetDataStr; + Count := Pos('MD5-', Str); + + If Count > 0 Then + MD5Challenge := Copy(Str, Count + 4, 255); + End; + +// WriteLn ('AuthState: ', GetStateStr(AuthState), ', HasHeader: ', HaveHeader, ' Data: ', GetDataStr); + + Case AuthState of + SendChallenge : Begin // Send MD5 digest + End; + SendWelcome : Begin + SendFrame (M_NUL, 'SYS Sector7'); + SendFrame (M_NUL, 'ZYZ g00r00'); + SendFrame (M_NUL, 'LOC Philadelphia, PA'); + SendFrame (M_NUL, 'VER Mystic/1.10 binkp/1.1'); + + If IsClient Then + AuthState := SendAddress + Else + AuthState := WaitAddress; + End; + + SendAddress : Begin + SendFrame (M_ADR, '55:268/212@mysticnet'); + + AuthState := SendPassword; + End; + SendPassword : If HaveHeader Then Begin // wait for header to see if we support CRAMMD5 + If UseMD5 And (MD5Challenge <> '') Then Begin + Str := 'password'; + MD5Challenge := StrHex(MD5Challenge); + MD5Challenge := HexStr(HMAC_MD5(Str, MD5Challenge)); + + SendFrame (M_PWD, 'CRAM-MD5-' + MD5Challenge); + End Else + // if forced CRAMMD5 then error and exit otherwise... + SendFrame (M_PWD, 'password'); + + Client.BufFlush; + + HaveHeader := False; + NeedHeader := True; + AuthState := WaitPwdOK; + End; + WaitAddress : Begin + // get address + AuthState := WaitPassword; + End; + WaitPassword : ; + WaitPwdOK : If HaveHeader Then Begin + If RxCommand <> M_OK Then + AuthState := AuthFailed + Else + AuthState := AuthOK; + End; + End; + Until (AuthState = AuthOK) or (AuthState = AuthFailed); + + Result := AuthState = AuthOK; +End; + +Procedure TBinkP.DoTransfers; +Var + InFile : File; + OutFile : File; + OutSize : LongInt; + OutBuf : Array[1..BinkPMaxBufferSize] of Byte; + Str : String; + InFN : String; + InSize : Cardinal; + InPos : Cardinal; + InTime : Cardinal; + FSize : Cardinal; +Begin + WriteLn ('Begin File Transfers'); + + RxState := RxWaitFile; + TxState := TxNextFile; + TimeOut := TimerSet(BinkPTimeOut); + NeedHeader := True; + HaveHeader := False; + + Repeat + DoFrameCheck; + + // need to update states to handle getting FILE during an xfer + // and what to do if the file frame goes past file size (fail/quit), etc + +// waitms(100); +// writeln ('rxstate=', ord(rxstate), ' txstate=', ord(txstate), ' have header ', haveheader, ' need header ', needheader); + + Case RxState of + RxWaitFile : If HaveHeader Then Begin + If RxFrameType = Data Then Begin + HaveHeader := False; + NeedHeader := True; + + Continue; + End; + + If RxCommand = M_FILE Then Begin + HaveHeader := False; + NeedHeader := True; + + // translate filename, fix up file times + + Str := GetDataStr; + InFN := strWordGet(1, Str, ' '); + InSize := strS2I(strWordGet(2, Str, ' ')); + InTime := strS2I(strWordGet(3, Str, ' ')); + InPos := strS2I(strWordGet(4, Str, ' ')); + + If FileExist(InBoundPath + InFN) Then Begin + FSize := FileByteSize(InBoundPath + InFN); + + // fix timestamp and escape filen + + If FSize >= InSize Then Begin + SendFrame (M_SKIP, InFN + ' ' + strI2S(FSize) + ' ' + strI2S(TempFileTime)); + + Continue; + End Else Begin + SendFrame (M_GET, InFN + ' ' + strI2S(FSize) + ' ' + strI2S(TempFileTime)); + + InPos := FSize; + End; + End; + + Assign (InFile, InBoundPath + InFN); + Reset (InFile, 1); + + If IoResult <> 0 Then ReWrite (InFile, 1); + + Seek (InFile, InPos); + + RxState := RxGetData; + End Else + If RxCommand = M_EOB Then Begin + NeedHeader := True; + HaveHeader := False; + RxState := RxDone; + End; + End; + RxGetData : If HaveHeader And (RxFrameType = Data) Then Begin + BlockWrite (InFile, RxBuffer[1], RxBufSize); + + Inc (InPos, RxBufSize); + + HaveHeader := False; + NeedHeader := True; + + If InPos = InSize Then Begin + // fix time, escape filename + + Close (InFile); + SendFrame (M_GOT, InFN + ' ' + strI2S(InSize) + ' ' + strI2S(TempFileTime)); + + RxState := RxWaitFile; + End; + End; + End; + +// DoFrameCheck; + + Case TxState of + TxGetEOF : Begin + If HaveHeader Then + If RxCommand = M_GOT Then Begin + HaveHeader := False; + NeedHeader := True; + TxState := TxNextFile; + End; + End; + TxNextFile : If FileList.Next Then Begin + Assign (OutFile, FileList.QData[FileList.QPos].FilePath + FileList.QData[FileList.QPos].FileName); + Reset (OutFile, 1); + + If IoResult <> 0 Then Continue; + + // need to escape filename here and fix file time + SendFrame (M_FILE, FileList.QData[FileList.QPos].FileName + ' ' + strI2S(FileList.QData[FileList.QPos].FileSize) + ' ' + strI2S(TempFileTime) + ' 0'); + + TxState := TxSendData; + End Else Begin + SendFrame (M_EOB, ''); + + TxState := TxDone; + End; + TxSendData : Begin + If HaveHeader And (RxCommand = M_GET) Then Begin + Str := strWordGet(4, GetDataStr, ' '); + + Seek (OutFile, strS2I(Str)); + + // fix file time and escape filename + SendFrame (M_FILE, FileList.QData[FileList.QPos].FileName + ' ' + Str + ' 0 0'); + + HaveHeader := False; + NeedHeader := True; + + Continue; + End; + + BlockRead (OutFile, OutBuf, SizeOf(OutBuf), OutSize); + SendDataFrame (OutBuf, OutSize); + + If OutSize < SizeOf(OutBuf) Then Begin + Close (OutFile); + + TxState := TxGetEOF; + HaveHeader := False; + NeedHeader := True; + End; + End; + End; + Until ((RxState = RxDone) and (TxState = TxDone)) or (Not Client.Connected) or (TimerUp(TimeOut)); + + If Client.Connected Then Client.BufFlush; +End; + +Var + BinkP : TBinkP; + Client : TIOSocket; + Queue : TProtocolQueue; +Begin + Queue := TProtocolQueue.Create; + Client := TIOSocket.Create; + + Client.FTelnetClient := False; + Client.FTelnetServer := False; + + Queue.Add('d:\s7\echomail\inbound\t\', '0019ff33.mo0'); + 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); + + Client.Connect ('localhost', 24554); + + If BinkP.DoAuthentication Then + BinkP.DoTransfers; + + BinkP.Free; + Client.Free; + Queue.Free; +End.