mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 02:59:21 +02:00
* update lnet to 0.5.1 (fixes some potential bugs in ftp and smtp)
git-svn-id: trunk@7519 -
This commit is contained in:
Almindor
parent
55394d9e72
commit
e2ff152eef
@ -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;
|
||||
|
||||
@ -132,7 +132,7 @@ type
|
||||
procedure OnControlRe(aSocket: TLSocket);
|
||||
procedure OnControlCo(aSocket: TLSocket);
|
||||
procedure OnControlDs(aSocket: TLSocket);
|
||||
|
||||
|
||||
function GetTransfer: Boolean;
|
||||
|
||||
function GetEcho: Boolean;
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{ lNet v0.4.0
|
||||
{ lNet v0.5.1
|
||||
|
||||
CopyRight (C) 2004-2006 Ales Katona
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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** ');
|
||||
|
||||
Loading…
Reference in New Issue
Block a user