diff --git a/utils/fppkg/lnet/lcommon.pp b/utils/fppkg/lnet/lcommon.pp index 2309b87b1f..64890fdf22 100644 --- a/utils/fppkg/lnet/lcommon.pp +++ b/utils/fppkg/lnet/lcommon.pp @@ -220,7 +220,7 @@ var opt: DWord; begin opt := BlockAr[aValue]; - if ioctlsocket(aHandle, FIONBIO, opt) = SOCKET_ERROR then + if ioctlsocket(aHandle, Longint(FIONBIO), opt) = SOCKET_ERROR then Exit(False); Result := True; end; diff --git a/utils/fppkg/lnet/lftp.pp b/utils/fppkg/lnet/lftp.pp index 21dac8fb5a..e409274560 100644 --- a/utils/fppkg/lnet/lftp.pp +++ b/utils/fppkg/lnet/lftp.pp @@ -132,7 +132,7 @@ type procedure OnControlRe(aSocket: TLSocket); procedure OnControlCo(aSocket: TLSocket); procedure OnControlDs(aSocket: TLSocket); - + function GetTransfer: Boolean; function GetEcho: Boolean; diff --git a/utils/fppkg/lnet/lnet.pp b/utils/fppkg/lnet/lnet.pp index fc6e12b383..6aa50599d4 100644 --- a/utils/fppkg/lnet/lnet.pp +++ b/utils/fppkg/lnet/lnet.pp @@ -1,4 +1,4 @@ -{ lNet v0.4.0 +{ lNet v0.5.1 CopyRight (C) 2004-2006 Ales Katona diff --git a/utils/fppkg/lnet/lsmtp.pp b/utils/fppkg/lnet/lsmtp.pp index 8995366220..dfcfb68855 100644 --- a/utils/fppkg/lnet/lsmtp.pp +++ b/utils/fppkg/lnet/lsmtp.pp @@ -93,6 +93,7 @@ type TMail = class protected FMailText: string; + FMailStream: TStream; FRecipients: string; FSender: string; FSubject: string; @@ -103,6 +104,7 @@ type public property Attachments: TAttachmentList read FAttachments; property MailText: string read FMailText write FMailText; + property MailStream: TStream read FMailStream write FMailStream; property Sender: string read FSender write FSender; property Recipients: string read FRecipients write FRecipients; property Subject: string read FSubject write FSubject; @@ -148,15 +150,18 @@ type FOnSuccess: TLSMTPClientStatusEvent; FOnFailure: TLSMTPClientStatusEvent; FOnError: TLSocketErrorEvent; + FOnSent: TLSocketProgressEvent; FSL: TStringList; FStatusSet: TLSMTPStatusSet; - FMessage: string; + FBuffer: string; + FStream: TStream; protected procedure OnEr(const msg: string; aSocket: TLSocket); procedure OnRe(aSocket: TLSocket); procedure OnCo(aSocket: TLSocket); procedure OnDs(aSocket: TLSocket); + procedure OnCs(aSocket: TLSocket); protected function CanContinue(const aStatus: TLSMTPStatus; const Arg1, Arg2: string): Boolean; @@ -165,6 +170,9 @@ type procedure EvaluateAnswer(const Ans: string); procedure ExecuteFrontCommand; + + procedure InsertCRLFs; + procedure SendData(const FromStream: Boolean = False); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; @@ -175,7 +183,8 @@ type function Get(var aData; const aSize: Integer; aSocket: TLSocket = nil): Integer; virtual; function GetMessage(out msg: string; aSocket: TLSocket = nil): Integer; virtual; - procedure SendMail(const From, Recipients, Subject, Msg: string); + procedure SendMail(From, Recipients, Subject, Msg: string); + procedure SendMail(From, Recipients, Subject: string; aStream: TStream); procedure SendMail(aMail: TMail); procedure Helo(aHost: string = ''); @@ -198,17 +207,17 @@ type property OnSuccess: TLSMTPClientStatusEvent read FOnSuccess write FOnSuccess; property OnFailure: TLSMTPClientStatusEvent read FOnFailure write FOnFailure; property OnError: TLSocketErrorEvent read FOnError write FOnError; + property OnSent: TLSocketProgressEvent read FOnSent write FOnSent; end; implementation uses - SysUtils; + SysUtils, lMimeStreams; const EMPTY_REC: TLSMTPStatusRec = (Status: ssNone; Args: ('', '')); - SLE = #13#10; - + {$i lcontainers.inc} function StatusToStr(const aStatus: TLSMTPStatus): string; @@ -285,14 +294,14 @@ begin FPort := 25; FStatusSet := []; // empty set for "ok/not-ok" Event FSL := TStringList.Create; - FHost := ''; - FMessage := ''; // {$warning TODO: fix pipelining support when server does it} FPipeLine := False; FConnection.OnError := @OnEr; + FConnection.OnCanSend := @OnCs; FConnection.OnReceive := @OnRe; FConnection.OnConnect := @OnCo; + FConnection.OnDisconnect := @OnDs; FStatus := TLSMTPStatusFront.Create(EMPTY_REC); FCommandFront := TLSMTPStatusFront.Create(EMPTY_REC); @@ -332,6 +341,11 @@ begin FOnDisconnect(aSocket); end; +procedure TLSMTPClient.OnCs(aSocket: TLSocket); +begin + SendData(FStatus.First.Status = ssData); +end; + function TLSMTPClient.CanContinue(const aStatus: TLSMTPStatus; const Arg1, Arg2: string): Boolean; begin Result := FPipeLine or FStatus.Empty; @@ -347,7 +361,7 @@ begin if FSL.Count > 0 then for i := 0 to FSL.Count-1 do if Length(FSL[i]) > 0 then EvaluateAnswer(FSL[i]); - s := StringReplace(s, SLE, LineEnding, [rfReplaceAll]); + s := StringReplace(s, CRLF, LineEnding, [rfReplaceAll]); i := Pos('PASS', s); if i > 0 then s := Copy(s, 1, i-1) + 'PASS'; @@ -417,10 +431,7 @@ begin Eventize(FStatus.First.Status, True); FStatus.Remove; end; - 300..399: if Length(FMessage) > 0 then begin - FConnection.SendMessage(FMessage); - FMessage := ''; - end; + 300..399: SendData(True); else begin Eventize(FStatus.First.Status, False); FStatus.Remove; @@ -440,6 +451,7 @@ begin Disconnect; end; end; + if FStatus.Empty and not FCommandFront.Empty then ExecuteFrontCommand; end; @@ -459,6 +471,73 @@ begin FCommandFront.Remove; end; +procedure TLSMTPClient.InsertCRLFs; +var + i, c: Integer; +begin + c := 0; + i := 2; + while i <= Length(FBuffer) do begin + if (FBuffer[i - 1] = #13) and (FBuffer[i] = #10) then begin + c := 0; + Inc(i); + end else + Inc(c); + + if c >= 74 then begin + Insert(CRLF, FBuffer, i); + c := 0; + Inc(i, 2); + end; + + Inc(i); + end; +end; + +procedure TLSMTPClient.SendData(const FromStream: Boolean = False); +const + SBUF_SIZE = 65535; + + procedure FillBuffer; + var + s: string; + begin + SetLength(s, SBUF_SIZE - Length(FBuffer)); + SetLength(s, FStream.Read(s[1], Length(s))); + + FBuffer := FBuffer + s; + + if FStream.Position = FStream.Size then begin // we finished the stream + FBuffer := FBuffer + CRLF + '.' + CRLF; + FStream := nil; + end; + end; + +var + n: Integer; + Sent: Integer; +begin + if FromStream and Assigned(FStream) then + FillBuffer; + + n := 1; + Sent := 0; + while (Length(FBuffer) > 0) and (n > 0) do begin + InsertCRLFs; + + n := FConnection.SendMessage(FBuffer); + Sent := Sent + n; + if n > 0 then + Delete(FBuffer, 1, n); + + if FromStream and Assigned(FStream) and (Length(FBuffer) < SBUF_SIZE) then + FillBuffer; + end; + + if Assigned(FOnSent) and (FStatus.First.Status = ssData) then + FOnSent(FConnection.Iterator, Sent); +end; + function TLSMTPClient.Connect(const aHost: string; const aPort: Word = 25): Boolean; begin Result := False; @@ -495,24 +574,51 @@ begin Result := CleanInput(msg); end; -procedure TLSMTPClient.SendMail(const From, Recipients, Subject, Msg: string); +procedure TLSMTPClient.SendMail(From, Recipients, Subject, Msg: string); var i: Integer; begin + FStream := nil; + From := EncodeMimeHeaderText(From); + Recipients := EncodeMimeHeaderText(Recipients); + Subject := EncodeMimeHeaderText(Subject); + if (Length(Recipients) > 0) and (Length(From) > 0) then begin Mail(From); FSL.CommaText := StringReplace(Recipients, ' ', ',', [rfReplaceAll]); for i := 0 to FSL.Count-1 do Rcpt(FSL[i]); - Data('From: ' + From + SLE + 'Subject: ' + Subject + SLE + 'To: ' + FSL.CommaText + SLE + Msg); + Data('From: ' + From + CRLF + 'Subject: ' + Subject + CRLF + 'To: ' + FSL.CommaText + CRLF + Msg); + Rset; + end; +end; + +procedure TLSMTPClient.SendMail(From, Recipients, Subject: string; aStream: TStream); +var + i: Integer; +begin + From := EncodeMimeHeaderText(From); + Recipients := EncodeMimeHeaderText(Recipients); + Subject := EncodeMimeHeaderText(Subject); + + FStream := aStream; + + if (Length(Recipients) > 0) and (Length(From) > 0) then begin + Mail(From); + FSL.CommaText := StringReplace(Recipients, ' ', ',', [rfReplaceAll]); + for i := 0 to FSL.Count-1 do + Rcpt(FSL[i]); + Data('From: ' + From + CRLF + 'Subject: ' + Subject + CRLF + 'To: ' + FSL.CommaText + CRLF); Rset; end; end; procedure TLSMTPClient.SendMail(aMail: TMail); begin - // TODO: incorporate attachments + encoding - SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailText); + if Length(aMail.MailText) > 0 then + SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailText) + else if Assigned(aMail.MailStream) then + SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailStream); end; procedure TLSMTPClient.Helo(aHost: string = ''); @@ -520,8 +626,9 @@ begin if Length(Host) = 0 then aHost := FHost; if CanContinue(ssHelo, aHost, '') then begin - FConnection.SendMessage('HELO ' + aHost + SLE); + FBuffer := FBuffer + 'HELO ' + aHost + CRLF; FStatus.Insert(MakeStatusRec(ssHelo, '', '')); + SendData; end; end; @@ -530,50 +637,61 @@ begin if Length(aHost) = 0 then aHost := FHost; if CanContinue(ssEhlo, aHost, '') then begin - FConnection.SendMessage('EHLO ' + aHost + SLE); + FBuffer := FBuffer + 'EHLO ' + aHost + CRLF; FStatus.Insert(MakeStatusRec(ssEhlo, '', '')); + SendData; end; end; procedure TLSMTPClient.Mail(const From: string); begin if CanContinue(ssMail, From, '') then begin - FConnection.SendMessage('MAIL FROM:' + '<' + From + '>' + SLE); + FBuffer := FBuffer + 'MAIL FROM:' + '<' + From + '>' + CRLF; FStatus.Insert(MakeStatusRec(ssMail, '', '')); + SendData; end; end; procedure TLSMTPClient.Rcpt(const RcptTo: string); begin if CanContinue(ssRcpt, RcptTo, '') then begin - FConnection.SendMessage('RCPT TO:' + '<' + RcptTo + '>' + SLE); + FBuffer := FBuffer + 'RCPT TO:' + '<' + RcptTo + '>' + CRLF; FStatus.Insert(MakeStatusRec(ssRcpt, '', '')); + SendData; end; end; procedure TLSMTPClient.Data(const Msg: string); begin if CanContinue(ssData, Msg, '') then begin - // TODO: clean SLEs and '.' on line starts - FMessage := Msg + SLE + '.' + SLE; - FConnection.SendMessage('DATA' + SLE); + if Assigned(FStream) then begin + if Length(Msg) > 0 then + FBuffer := 'DATA ' + Msg + else + FBuffer := 'DATA '; + end else + FBuffer := 'DATA ' + Msg + CRLF + '.' + CRLF; + FStatus.Insert(MakeStatusRec(ssData, '', '')); + SendData(True); end; end; procedure TLSMTPClient.Rset; begin if CanContinue(ssRset, '', '') then begin - FConnection.SendMessage('RSET' + SLE); + FBuffer := FBuffer + 'RSET' + CRLF; FStatus.Insert(MakeStatusRec(ssRset, '', '')); + SendData; end; end; procedure TLSMTPClient.Quit; begin if CanContinue(ssQuit, '', '') then begin - FConnection.SendMessage('QUIT' + SLE); + FBuffer := FBuffer + 'QUIT' + CRLF; FStatus.Insert(MakeStatusRec(ssQuit, '', '')); + SendData; end; end; diff --git a/utils/fppkg/lnet/ltelnet.pp b/utils/fppkg/lnet/ltelnet.pp index 584890ef8c..98cb45d5a3 100644 --- a/utils/fppkg/lnet/ltelnet.pp +++ b/utils/fppkg/lnet/ltelnet.pp @@ -87,6 +87,8 @@ type FCommandArgs: string[3]; FOrders: TLTelnetControlChars; FConnected: Boolean; + FBuffer: string; + function Question(const Command: Char; const Value: Boolean): Char; function GetTimeout: DWord; @@ -104,6 +106,8 @@ type procedure React(const Operation, Command: Char); virtual; abstract; procedure SendCommand(const Command: Char; const Value: Boolean); virtual; abstract; + + procedure OnCs(aSocket: TLSocket); public constructor Create(aOwner: TComponent); override; destructor Destroy; override; @@ -136,8 +140,6 @@ type { TLTelnetClient } - { TLTelnetClient } - TLTelnetClient = class(TLTelnet, ILClient) protected FLocalEcho: Boolean; @@ -145,7 +147,7 @@ type procedure OnDs(aSocket: TLSocket); procedure OnRe(aSocket: TLSocket); procedure OnCo(aSocket: TLSocket); - + procedure React(const Operation, Command: Char); override; procedure SendCommand(const Command: Char; const Value: Boolean); override; @@ -180,7 +182,10 @@ var constructor TLTelnet.Create(aOwner: TComponent); begin inherited Create(aOwner); + FConnection := TLTCP.Create(aOwner); + FConnection.OnCanSend := @OnCs; + FOutput := TMemoryStream.Create; FCommandCharIndex := 0; FStack := TLControlStack.Create; @@ -274,6 +279,20 @@ begin FOutput.WriteByte(Byte(msg[i])); end; +procedure TLTelnet.OnCs(aSocket: TLSocket); +var + n: Integer; +begin + n := 1; + + while n > 0 do begin + n := FConnection.SendMessage(FBuffer); + + if n > 0 then + System.Delete(FBuffer, 1, n); + end; +end; + function TLTelnet.OptionIsSet(const Option: Char): Boolean; begin Result := False; @@ -315,7 +334,8 @@ begin {$ifdef debug} Writeln('**SENT** ', TNames[Char(How)], ' ', TNames[aCommand]); {$endif} - FConnection.SendMessage(TS_IAC + Char(How) + aCommand); + FBuffer := FBuffer + TS_IAC + Char(How) + aCommand; + OnCs(nil); end; //****************************TLTelnetClient***************************** @@ -327,6 +347,7 @@ begin FConnection.OnDisconnect := @OnDs; FConnection.OnReceive := @OnRe; FConnection.OnConnect := @OnCo; + FConnected := False; FPossible := [TS_ECHO, TS_HYI, TS_SGA]; FActive := []; @@ -373,7 +394,8 @@ procedure TLTelnetClient.React(const Operation, Command: Char); {$ifdef debug} Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]); {$endif} - FConnection.SendMessage(TS_IAC + Operation + Command); + FBuffer := FBuffer + TS_IAC + Operation + Command; + OnCs(nil); end; procedure Refuse(const Operation, Command: Char); @@ -382,7 +404,8 @@ procedure TLTelnetClient.React(const Operation, Command: Char); {$ifdef debug} Writeln('**SENT** ', TNames[Operation], ' ', TNames[Command]); {$endif} - FConnection.SendMessage(TS_IAC + Operation + Command); + FBuffer := FBuffer + TS_IAC + Operation + Command; + OnCs(nil); end; begin @@ -411,7 +434,8 @@ begin case Question(Command, Value) of TS_WILL : FActive := FActive + [Command]; end; - FConnection.SendMessage(TS_IAC + Question(Command, Value) + Command); + FBuffer := FBuffer + TS_IAC + Question(Command, Value) + Command; + OnCs(nil); end; end; @@ -459,7 +483,11 @@ begin DoubleIAC(Tmp); if LocalEcho and (not OptionIsSet(TS_ECHO)) and (not OptionIsSet(TS_HYI)) then FOutput.Write(PChar(Tmp)^, Length(Tmp)); - Result := FConnection.SendMessage(Tmp); + + FBuffer := FBuffer + Tmp; + OnCs(nil); + + Result := aSize; end; {$ifdef debug} Writeln('**SEND END** ');