* update lnet to 0.5.1 (fixes some potential bugs in ftp and smtp)

git-svn-id: trunk@7519 -

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;

utils/fppkg/lnet/lnet.pp

@@ -1,4 +1,4 @@
-{ lNet v0.4.0
+{ lNet v0.5.1
 
   CopyRight (C) 2004-2006 Ales Katona
 

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,16 +207,16 @@ 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}
 
@@ -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
+                300..399: SendData(True);
-                            FConnection.SendMessage(FMessage);
-                            FMessage := '';
-                          end;
               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
+  if Length(aMail.MailText) > 0 then
-  SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailText);
+    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
+    if Assigned(FStream) then begin
-    FMessage := Msg + SLE + '.' + SLE;
+      if Length(Msg) > 0 then
-    FConnection.SendMessage('DATA' + SLE);
+        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;
 

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;
@@ -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** ');